MyIO.hs

{-# LANGUAGE BlockArguments #-}

import Control.Monad (ap, when)
import System.Exit (exitSuccess)

data MyIO a
  = GetLine (String -> MyIO a)
  | PutStrLn String (MyIO a)
  | ExitSuccess
  | Pure a

instance Functor MyIO where
  fmap f (GetLine next) = GetLine \input -> fmap f (next input)
  fmap f (PutStrLn output next) = PutStrLn output (fmap f next)
  fmap f ExitSuccess = ExitSuccess
  fmap f (Pure x) = Pure (f x)

instance Applicative MyIO where
  pure = Pure
  (<*>) = ap

instance Monad MyIO where
  GetLine next >>= f = GetLine \input -> next input >>= f
  PutStrLn output next >>= f = PutStrLn output (next >>= f)
  ExitSuccess >>= f = ExitSuccess
  Pure x >>= f = f x

myGetLine :: MyIO String
myGetLine = GetLine (\input -> Pure input)

myPutStrLn :: String -> MyIO ()
myPutStrLn output = PutStrLn output (Pure ())

myExitSuccess :: MyIO a
myExitSuccess = ExitSuccess

runMyIO :: MyIO a -> IO a
runMyIO (GetLine next) = getLine >>= runMyIO . next
runMyIO (PutStrLn output next) = putStrLn output >> runMyIO next
runMyIO ExitSuccess = exitSuccess
runMyIO (Pure x) = pure x

myMain :: MyIO ()
myMain = do
  myPutStrLn "Enter name:"
  name <- myGetLine
  when (null name) do
    myPutStrLn "invalid name"
    myExitSuccess
  myPutStrLn $ "Your name is " <> name

main :: IO ()
main = runMyIO myMain