oi.hs

{-# LANGUAGE GADTs, KindSignatures #-}

import Data.List (splitAt, findIndex)

data OI :: * -> * where
  Return :: a -> OI a
  GetLine :: OI String
  PutLine :: String -> OI ()
  Bind :: OI b -> (b -> OI a) -> OI a

instance Functor OI where
  fmap f o = Bind o (Return . f)

instance Applicative OI where
  pure = Return
  f <*> a = Bind f (\fv -> Bind a (\av -> Return (fv av)))

instance Monad OI where
  (>>=) = Bind

runOI :: OI a -> IO a
runOI oi = case oi of
  Return v -> return v
  GetLine -> getLine
  PutLine s -> putStrLn s
  Bind o f -> runOI o >>= runOI . f

interacted' :: OI a -> String -> (String, String, a)
interacted' oi = case oi of
  Return v -> \s -> (s, "", v)
  GetLine -> \s -> case findIndex (== '\n') s of
    Just i -> let (a, b) = splitAt i s in (tail b, "", a)
  PutLine v -> \s -> (s, v ++ "\n", ())
  Bind o f -> \s -> let
    (s', out, v) = interacted' o s
    (s'', out', v') = interacted' (f v) s'
    in (s'', out ++ out', v')

interacted :: OI a -> (String -> String)
interacted oi s = let (s', out, v) = interacted' oi s in out

askLoop :: OI ()
askLoop = do
  PutLine "What's your name?"
  name <- GetLine
  PutLine $ "Hello, " ++ name
  askLoop