{-# LANGUAGE InstanceSigs, MultiParamTypeClasses, FlexibleInstances #-}
import System.IO
import System.Environment
import Control.Monad hiding (MonadPlus, mzero, mplus)

data Identity a = Id a

runIdentity :: Identity a -> a
runIdentity (Id x) = x

runMaybeT :: (Monad m) => MaybeT m a -> m (Maybe a)
runMaybeT (MT c) = c
-- f :: a -> b -> c == a -> (b -> c)
runStateT :: StateT s m a -> (s -> m (s, a))
runStateT (ST f) = f

-- data Parser a = P (String -> Maybe (a, String))  
type Parser a = StateT String (MaybeT Identity) a

parse :: String -> Parser a -> Maybe (String, a)    
parse s h = runIdentity (runMaybeT (runStateT h s))
  -- h :: StateT String (MaybeT Identity) a
  -- runStateT h :: String -> MaybeT Identity (String, a)
  -- runStateT h s :: MaybeT Identity (String, a)
  -- runMaybeT (runStateT h s) :: Identity (Maybe (String, a))

zero :: Parser a
zero = mzero

(<|>) :: Parser a -> Parser a -> Parser a
(<|>) f1 f2 = mplus f1 f2

-- zero <|> p == p == p <|> zero
-- (p1 <|> p2) <|> p3 == p1 <|> (p2 <|> p3)

item :: Parser Char
item = do
  s <- get
  if null s then mzero
    else do
      put (tail s)
      return (head s)
    
  -- P $ \ s ->
  -- if null s then Nothing else Just (head s, tail s)

eos :: Parser ()
eos = do
  s <- get 
  if null (s :: String) then return ()
    else mzero
    
 -- P $ \ s ->
 --  if null s then Just ((), [])
 --  else Nothing


char :: Char -> Parser Char
char x = do
  c <- item
  if x == c then return c
    else mzero 
  
-- many p tries to use the parser p
-- zero or more times. 

-- manyH :: Parser a -> Parser [a]   
-- manyH p = do
--   r <- p
--   rs <- manyH p
--   return (r:rs)

-- try p = do{r <- p; return [r]} <|> return []

-- not quite what we want 
-- many p = try (manyH p)

many :: Parser a -> Parser [a]   
many p = many1 p <|> return []


-- apply p one or more times. 
many1 :: Parser a -> Parser [a]
many1 p =
  do{r <- p; rs <- many p; return (r:rs)}

-- sepBy p sep parses p zero or more times separated by sep
-- 0
-- p
-- p, p
-- p, p, p
sepBy :: Parser a -> Parser b -> Parser [a]
sepBy p sep = sepBy1 p sep <|> return []

-- sepBy p sep parses p one or more times separated by sep
-- p
-- p  ,p
-- p ,p ,p
-- ...  
sepBy1 :: Parser a -> Parser b -> Parser [a]
sepBy1 p sep = do
  r <- p
  rs <- many (sep >> p)
  return (r:rs)

newline :: Parser ()
newline = 
  char '\n' >> return ()

csv :: Parser [[String]]
csv = many line

line :: Parser [String]
line = do
  rs <- sepBy1 content (char ',')
  newline
  return rs

content :: Parser String
content = many allowedChar

allowedChar :: Parser Char 
allowedChar = do
  c <- item
  if c `elem` "\n.;:," then zero
    else return c
  
    

main :: IO ()
main = do
  args <- getArgs
  case args of
    [filename] -> do
      h <- openFile filename ReadMode
      str <- hGetContents h
      case parse str csv of
        Nothing -> error "failed to parse"
        Just (r, result) -> 
          if null r then 
            putStrLn $ show result
          else
            error $ "leftover string:" ++ r
          
          -- result :: [[String]]
          -- putStrLn $ concat $ concat result
          -- hClose h
      
    _ -> error "wrong arguments"

---------------------------------
-- Monad transformers

mapLM :: (a -> b) -> [Maybe a] -> [Maybe b]
mapLM f l = fmap (fmap f) l
  
return1 :: a -> [Maybe a]
return1 x = [Just x]

join1 :: [Maybe [Maybe a]] -> [Maybe a]
join1 [] = []
join1 (Nothing:xs) = Nothing : join1 xs
join1 (Just l : xs) = l ++ join1 xs




instance MonadTrans MaybeT where
  lift :: (Monad m) => m a -> MaybeT m a
  lift c = MT $ do{r <- c; return (Just r) }
  -- m (Maybe a), c :: m a

instance (Monad m) => Functor (MaybeT m) where
  fmap :: (a -> b) -> MaybeT m a -> MaybeT m b
  fmap f (MT c) = MT $ do{ maybeA <- c; return (fmap f maybeA)}
  -- :: m (Maybe b), c :: m (Maybe a)
    -- fmap f maybeA :: Maybe b
  
instance (Monad m) => Applicative (MaybeT m) where
  
instance (Monad m) => Monad (MaybeT m) where
  return :: a -> MaybeT m a
  return x = MT $ return (Just x)  -- m (Maybe a), x : a

  (>>=) :: MaybeT m a -> (a -> MaybeT m b) -> MaybeT m b
  (MT c) >>= f = MT $ do{ r <- c;
                          case r of
                            Nothing -> return Nothing
                            Just x -> let MT d = f x in d
                            -- d :: m (Maybe b) 
                            }
    -- goal:  expression :: m (Maybe b)
    -- we have: c :: m (Maybe a)
    -- f :: a -> MaybeT m b
    -- r :: Maybe a

type ListOfMaybe a = MaybeT [] a

v1 :: MaybeT [] a
v1 = MT ([Nothing])

v2 :: MaybeT [] Int
v2 = MT ([Nothing, Just 1, Just 2])


v3 :: MaybeT IO Int  -- IO (Maybe Int)
v3 = do
  lift $ putStrLn "hello world"
  return 1

-- class (Monad m) => MonadPlus m where
--   mzero :: m a
--   mplus :: m a -> m a -> m a

data MaybeT m a = MT (m (Maybe a))

class (Monad m) => MonadPlus m where
  mzero :: m a
  mplus :: m a -> m a -> m a
  
instance (Monad m) => MonadPlus (MaybeT m) where
  mzero :: MaybeT m a
  mzero = MT $ return Nothing  -- m (Maybe a)

  mplus :: MaybeT m a -> MaybeT m a -> MaybeT m a
  mplus (MT c1) (MT c2) = MT $ do{r1 <- c1;
                                  case r1 of
                                    Nothing -> c2
                                    Just x -> return (Just x)
                                     }

instance (MonadPlus m) => MonadPlus (StateT s m) where
  mzero :: StateT s m a
  mzero = lift mzero
    -- lift :: m a -> StateT s m a 
    -- ST $ \ x -> mzero -- :: m (s, a)

  mplus :: StateT s m a -> StateT s m a -> StateT s m a
  mplus (ST f1) (ST f2) = ST $ \ x -> mplus (f1 x) (f2 x)
  -- m (s, a)
    -- f1, f2 :: s -> m (s, a)
    
    
    

v4 :: MaybeT IO Int  -- IO (Maybe Int)
v4 = do
  lift $ putStrLn "hello world"
  mzero `mplus` return 1 
--  return 1




instance Functor Identity where
  fmap :: (a -> b) -> Identity a -> Identity b
  fmap f (Id x) = Id (f x)

instance Applicative Identity where

instance Monad Identity where
  return :: a -> Identity a
  return x = Id x

  (>>=) :: Identity a -> (a -> Identity b) -> Identity b
  (Id x) >>= f = f x
  

data State s a = S (s -> (a, s))

type MaybeMonad a = MaybeT Identity a

v5 :: MaybeMonad Int
v5 = return 5

v6 :: MaybeMonad Int
v6 = do
  r <- v5
  return (r + 1)





class MonadTrans t where
  lift :: (Monad m) => m a -> (t m) a

instance MonadTrans (StateT s) where
  lift :: (Monad m) => m a -> StateT s m a
  lift c = ST $ \ x -> do{r <- c; return (x, r)}
  -- :: m (s , a)

instance (Monad m) => Functor (StateT s m) where
  fmap :: (a -> b) -> StateT s m a -> StateT s m b
  fmap f (ST g) = ST $ \ x -> do{(x', r) <- g x; return (x', f r)}
    -- s -> m (b, s)
    -- g :: s -> m (a, s)
    -- g x :: m (a , s)
    -- r :: a
    -- x' :: s
    -- f r :: b
instance (Monad m) => Applicative (StateT s m) where
  
instance (Monad m) => Monad (StateT s m) where
  return :: a -> StateT s m a
  return x = ST $ \ s -> return (s, x) -- :: m (s, x)

  (>>=) :: StateT s m a -> (a -> StateT s m b) -> StateT s m b
  (ST g) >>= f =
    ST $ \ s -> do{ (s', r) <- g s;  runStateT (f r) s'}    -- m (s, b)
    -- g :: s -> m (s, a)
    -- f r :: StateT s m b
    -- runStateT (f r) :: s -> m (s, b)
    -- runStateT (f r) s :: m (s , b)

class MonadState m s where
  get :: m s
  put :: s -> m ()
  
data StateT s m a = ST (s -> m (s, a))

instance (Monad m) => MonadState (StateT s m) s where
  get :: StateT s m s
  get = ST $ \ x -> return (x, x)  -- :: m (s , s)

  put :: s -> StateT s m ()
  put x = ST $ \ y -> return (x, ())     -- :: m (s, ())