Skip to content

Instantly share code, notes, and snippets.

@kana-sama

kana-sama/MyIO.hs

Created Aug 30, 2020
Embed
What would you like to do?
{-# 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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.