モナド変換子(その１: 基本） ref: https://qiita.com/HirotoShioi/items/8a6107434337b30ce457

file0.txt

someFun :: Env -> IO ()
...

someHandling :: Env -> Int -> IO Int
...

file1.txt

-- Somedataを処理する関数
someFun :: SomeData -> Either String SomeData
....

-- SomeDataからIntを算出する関数
someEither :: SomeData -> Either String Int

file10.txt

eval :: Expr -> Int
eval (Lit n)     = n
eval (Add e1 e2) = eval e1 + eval e2

file11.txt

λ: eval (Add (Add (Lit 3) (Lit 4)) (Lit 10))
17

file12.txt

data Expr =
    Lit Int
  | Add Expr Expr
  | Div Expr Expr

file13.txt

eval :: Expr -> Int
eval (Lit n)     = n
eval (Add e1 e2) = eval e1 + eval e2
eval (Div e1 e2) = eval e1 `div` eval e2

file14.txt

λ:eval (Div (Lit 10) (Lit 0))
*** Exception: divide by zero

file15.txt

eval :: Expr -> Either String Int
eval (Lit n)     = pure n
eval (Add e1 e2) = (+) <$> eval e1 <*> eval e2
eval (Div e1 e2) = do
  v1 <- eval e1
  v2 <- eval e2
  if v2 == 0
    then Left "division by 0"
    else return (v1 `div` v2)

file16.txt

eval :: Expr -> ??? Int
eval :: (Lit n)     = pure n
eval :: (Add e1 e2) = (+) <$> eval e1 <*> eval e2

file17.txt

eval :: Expr -> Identity Int
eval (Lit n)     = pure n
eval (Add e1 e2) = (+) <$> eval e1 <*> eval e2

file18.txt

λ: runIdentity $ eval (Add (Lit 10) (Lit 7))
17

file19.txt

eval :: Expr -> ExceptT String Identity Int
eval (Lit n)     = pure n
eval (Add e1 e2) = (+) <$> eval e1 <*> eval e2
eval (Div e1 e2) = do
  v1 <- eval e1
  v2 <- eval e2
  if v2 == 0
    then throwError "division by 0"
    else return (v1 `div` v2)

file2.txt

newtype ErrorState a = ErrorState { runErrorState :: s -> Either String (a, s) }

file20.txt

run :: Expr -> Either String Int
run expr = runIdentity (runExceptT (eval expr))

file21.txt

data Expr =
    Lit Int
  | Add Expr Expr
  | Div Expr Expr
  | Var String

file22.txt

type Env = Map String Int

file23.txt

eval :: Expr -> ReaderT Env (ExceptT String Identity) Int

file24.txt

type Eval = ReaderT Env (ExceptT String Identity) Int
-- or
newtype Eval a = Eval (ReaderT Env (ExceptT String Identity) a)

file25.txt

type Message = String

newtype Message = Message String

file26.txt

someFun :: Message -> Maybe Char

file27.txt

-- Why?
evilFun :: Message -> Char
evilFun = head

file28.txt

newtype Message = Message String

-- Stringとは全く別の型クラスインスタンスが実装可能
instance Show Message where
   show msg = "New typeclass instance for show" <> show msg

file29.txt

newtype Eval a = Eval (ExceptT String Identity) a
    deriving (???)

file3.txt

instance Monad (ErrorState e) where
  return a   = ErrorState $ \s -> Right (a, s)

  m >>= cont = ErrorState $ \s -> case runErrorState m s of
      (Left e)        -> Left e
      (Right (a, s')) -> runErrorState (cont a) s'

file30.txt

{-# LANGUAGE GeneralizedNewtypeDeriving #-}

newtype Quantity = Quantity Int
  deriving (Eq, Ord, Num, Show)

a = Quantity 2
b = Quantity 6

totalQuantity :: Quantity
totalQuantity = a + b
-- Quantity 8

file31.txt

class (Monad m) => MonadReader r m | m -> r where
  ask   :: m r
  local :: (r -> r) -> m a -> m a

instance (Monad m) => MonadReader r (ReaderT r m) where
  ask       = ReaderT return
  local f m = ReaderT $ \r -> runReaderT m (f r)

file32.txt

newtype App a = App (ReaderT [Int] (Either String) a)
  deriving (Functor
          , Applicative
          , Monad
          , MonadReader [Int])

file33.txt

newtype Eval a = Eval (ReaderT Env (ExceptT String Identity) a)
  deriving (Functor
          , Applicative
          , Monad
          , MonadReader Env
          , MonadError String)

file34.txt

eval :: Expr -> Eval Int

file35.txt

runEval :: Eval a -> Env -> Either String a
runEval (Eval m) env = runIdentity (runExceptT (runReaderT m env))

file36.txt

eval (Var x) = do
  env <- ask
  case M.lookup x env of
    Nothing -> throwError $ "Variable not found: " <> show x
    Just num -> pure num

file37.txt

λ: runEval (eval (Add (Var "x") (Lit 10))) (singleton "x" 10)
Right 20

file38.txt

data Expr =
    Lit Int
  | Add Expr Expr
  | Div Expr Expr
  | Var String
  | Seq Expr Expr
  | Assign String Expr

file39.txt

-- Before (ReaderT)
newtype Eval a = Eval (ReaderT Env (ExceptT String Identity) a)
  deriving (Functor, Applicative, Monad, MonadReader Env, MonadError String)

-- After (StateT)
newtype Eval a = Eval (StateT Env (ExceptT String Identity) a)
  deriving (Functor, Applicative, Monad, MonadState Env, MonadError String)

file4.txt

instance Functor (ErrorState e) where
  fmap = liftM

instance Applicative (ErrorState e) where
  pure = return
  (<*>) = ap

file40.txt

-- Before (ReaderT)
runEval :: Eval a -> Env -> Either String a
runEval (Eval m) env = runIdentity (runExceptT (runReaderT m env))

-- After (StateT)
runEval :: Eval a -> Env -> Either String a
runEval (Eval m) env = runIdentity (runExceptT (evalStateT m env))

file41.txt

eval (Var x) = do
  env <- get -- ask
  case M.lookup x env of
    Nothing -> throwError $ "Variable not found: " <> show x
    Just num -> pure num

file42.txt

eval (Seq e1 e2) = e1 >> e2

file43.txt

eval (Assign x e) = do
  v <- eval e
  modify (M.insert x v)
  return v

file44.txt

program :: Expr
program = Assign "x" (Lit 10)
          `Seq` Assign "x" (Div (Var "x") (Lit 2))
          `Seq` Add (Var "x") (Lit 1)

file45.txt

let x = 10;
x = x / 2;
console.log (x + 1);

file46.txt

λ: runEval (eval program) empty
Right 6

file47.txt

{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Interpreter where

import Control.Monad.Identity
import Control.Monad.Except
import Control.Monad.State

import Data.Map
import qualified Data.Map as M

import Data.Monoid ((<>))

type Env = Map String Int

data Expr =
    Lit Int
  | Add Expr Expr
  | Div Expr Expr
  | Var String
  | Assign String Expr
  | Seq Expr Expr

newtype Eval a = Eval (StateT Env (ExceptT String Identity) a)
  deriving (Functor, Applicative, Monad, MonadState Env, MonadError String)

eval :: Expr -> Eval Int
eval (Lit n)     = pure n
eval (Add e1 e2) = (+) <$> eval e1 <*> eval e2
eval (Div e1 e2) = doDiv e1 e2
eval (Var x) = varLookup x
eval (Seq e1 e2)  = eval e1 >> eval e2
eval (Assign x e) = varSet x e

doDiv :: Expr -> Expr -> Eval Int
doDiv e1 e2 = do
  v1 <- eval e1
  v2 <- eval e2
  if v2 == 0
    then divByZeroError
    else return (v1 `div` v2)

divByZeroError :: Eval a
divByZeroError = throwError "Division by 0"

varLookup :: String -> Eval Int
varLookup x = do
  env <- get
  case M.lookup x env of
    Nothing -> unknownVar x
    Just num -> return num

varSet :: String -> Expr -> Eval Int
varSet x e = do
  v <- eval e
  modify (M.insert x v)
  return v

unknownVar :: String -> Eval a
unknownVar x = throwError $ "Variable not found: " <> show x

runEval :: Eval a -> Env -> Either String a
runEval (Eval m) env = runIdentity (runExceptT (evalStateT m env))

program :: Expr
program = Assign "x" (Lit 10)
          `Seq` Assign "x" (Div (Var "x") (Lit 2))
          `Seq` Add (Var "x") (Lit 1)

file48.txt

λ: runEval (eval (Add (Lit 10) (Get)) empty
Please enter a number
10
Right 20

file5.txt

get :: ErrorState s s
get = ErrorState $ \s -> Right (s, s)

put :: s -> ErrorState s ()
put = ErrorState $ \_ -> Right ((), s)

modify :: (s -> s) -> ErrorState s ()
modify f = get >>= \s -> put (f s)

file6.txt

throwError :: String -> ErrorState s a
throwError str = ErrorState $ \_ -> Left e

file7.txt

addEven :: Int -> ErrorState Int ()
addEven num = if odd num
    then throwError $ "Invalid number: " ++ show num
    else modify (+ num)

file8.txt

λ: runErrorState (addEven 10) 10
Right ((),20)
λ: runErrorState (addEven 11) 10
Left "Invalid number: 11"

file9.txt

data Expr =
    Lit Int
  | Add Expr Expr