Complete chapter 26

26-monad-transformers/26-monad-transformers.md

@@ -0,0 +1,46 @@
+# 26 Monad Transformers
+
+## 26.3 EitherT
+
+see [src/EitherT.hs](./src/EitherT.hs)
+
+## 26.5 StateT
+
+see [src/StateT.hs](./src/StateT.hs)
+
+## 26.8 Wrap it up
+
+see [src/WrapItUp.hs](./src/WrapItUp.hs)
+
+## 26.9 Exercises: Lift More
+
+1. see [src/EitherT.hs](./src/EitherT.hs)
+2. see [src/StateT.hs](./src/StateT.hs)
+
+## 26.10 Exercises: Some Instances
+
+1. see [src/MaybeT.hs](./src/MaybeT.hs)
+2. see [src/ReaderT.hs](./src/ReaderT.hs)
+3. see [src/StateT.hs](./src/StateT.hs)
+
+## 26.12 Hypothetical Exercise
+
+see [src/Hypo.hs](./src/Hypo.hs)
+
+## 26.14 Chapter Exercises
+
+### Write the code
+
+see [src/WriteTheCode.hs](./src/WriteTheCode.hs)
+
+### Fix the code
+
+see [src/FixTheCode.hs](./src/FixTheCode.hs)
+
+### Hit counter
+
+see [hit-counter/Main.hs](./hit-counter/Main.hs)
+
+### Morra
+
+see [morra/src/Morra.hs](./morra/src/Morra.hs)

26-monad-transformers/hit-counter/Main.hs

@@ -0,0 +1,57 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Main where
+
+import Control.Monad.Trans.Class
+import Control.Monad.Trans.Reader
+import Data.IORef
+import qualified Data.Map as M
+-- import Data.Maybe (fromMaybe)
+import Data.Text.Lazy (Text)
+import qualified Data.Text.Lazy as TL
+import System.Environment (getArgs)
+import Web.Scotty.Trans
+
+import Control.Monad.IO.Class
+
+data Config =
+  Config {
+    counts :: IORef (M.Map Text Integer)
+  , prefix :: Text
+  }
+
+type Scotty = ScottyT Text (ReaderT Config IO)
+type Handler = ActionT Text (ReaderT Config IO)
+
+bumpBoomp :: Text -> M.Map Text Integer -> (M.Map Text Integer, Integer)
+bumpBoomp k m = let m' = M.insertWith (+) k 1 m
+                in (m', (M.!) m' k)
+
+updateHitCounter :: Text -> ReaderT Config IO Integer
+updateHitCounter t = do
+  c <- ask
+  m <- liftIO $ readIORef (counts c)
+  let (m', n) = bumpBoomp t m
+  liftIO $ writeIORef (counts c) m'
+  return n
+
+app :: Scotty ()
+app =
+  get "/:key" $ do
+    unprefixed <- param "key"
+    config <- lift ask
+    let key' = mappend (prefix config) unprefixed
+    newInteger <- lift $ updateHitCounter key'
+    html $
+      mconcat [ "<h1>Success! Count was: "
+              , TL.pack $ show newInteger
+              , "</h1>"
+              ]
+
+main :: IO ()
+main = do
+  [prefixArg] <- getArgs
+  counter <- newIORef M.empty
+  let config = Config { counts = counter, prefix = TL.pack prefixArg }
+      runR = flip runReaderT config
+  scottyT 3000 runR app

26-monad-transformers/hit-counter/hit-counter.cabal

@@ -0,0 +1,15 @@
+name:          hit-counter
+version:       0.0.0
+cabal-version: >= 1.8
+build-type:    Simple
+
+executable          hit-counter
+    hs-source-dirs: .
+    main-is:        Main.hs
+    ghc-options:    -Wall -threaded -O2 -rtsopts -with-rtsopts=-N
+    extensions:     OverloadedStrings
+    build-depends:  base   >= 4      && < 5
+                  , scotty
+                  , transformers
+                  , containers
+                  , text

26-monad-transformers/hit-counter/stack.yaml

@@ -0,0 +1,65 @@
+# This file was automatically generated by 'stack init'
+#
+# Some commonly used options have been documented as comments in this file.
+# For advanced use and comprehensive documentation of the format, please see:
+# https://docs.haskellstack.org/en/stable/yaml_configuration/
+
+# Resolver to choose a 'specific' stackage snapshot or a compiler version.
+# A snapshot resolver dictates the compiler version and the set of packages
+# to be used for project dependencies. For example:
+#
+# resolver: lts-3.5
+# resolver: nightly-2015-09-21
+# resolver: ghc-7.10.2
+# resolver: ghcjs-0.1.0_ghc-7.10.2
+#
+# The location of a snapshot can be provided as a file or url. Stack assumes
+# a snapshot provided as a file might change, whereas a url resource does not.
+#
+# resolver: ./custom-snapshot.yaml
+# resolver: https://example.com/snapshots/2018-01-01.yaml
+resolver: lts-11.12
+
+# User packages to be built.
+# Various formats can be used as shown in the example below.
+#
+# packages:
+# - some-directory
+# - https://example.com/foo/bar/baz-0.0.2.tar.gz
+# - location:
+#    git: https://github.com/commercialhaskell/stack.git
+#    commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
+# - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a
+#  subdirs:
+#  - auto-update
+#  - wai
+packages:
+- .
+# Dependency packages to be pulled from upstream that are not in the resolver
+# using the same syntax as the packages field.
+# (e.g., acme-missiles-0.3)
+# extra-deps: []
+
+# Override default flag values for local packages and extra-deps
+# flags: {}
+
+# Extra package databases containing global packages
+# extra-package-dbs: []
+
+# Control whether we use the GHC we find on the path
+# system-ghc: true
+#
+# Require a specific version of stack, using version ranges
+# require-stack-version: -any # Default
+# require-stack-version: ">=1.7"
+#
+# Override the architecture used by stack, especially useful on Windows
+# arch: i386
+# arch: x86_64
+#
+# Extra directories used by stack for building
+# extra-include-dirs: [/path/to/dir]
+# extra-lib-dirs: [/path/to/dir]
+#
+# Allow a newer minor version of GHC than the snapshot specifies
+# compiler-check: newer-minor

26-monad-transformers/morra/Setup.hs

@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain

26-monad-transformers/morra/lib/Morra.hs

@@ -0,0 +1,154 @@
+module Morra
+    (runGame, Game(..), Player(..), PlayerType(..))
+    where
+
+import Data.Maybe (listToMaybe)
+import qualified Data.Map as M
+
+import Control.Monad (forever)
+import Control.Monad.Trans.State
+import Control.Monad.IO.Class
+import Control.Monad.Trans.Class
+
+import System.Exit (exitSuccess)
+import System.Random (randomRIO)
+import System.Console.ANSI
+import System.IO (hFlush, stdout)
+
+-- Two player game
+-- Player chooses 0-5 and number
+-- AI chooses 0-5 and number
+
+type Source = (Integer, Integer)
+type Table = M.Map Source Integer
+type Guesses = (Integer, Integer)
+
+data PlayerType = Human | AI Guesses Table deriving (Show, Eq)
+
+data Player = Player {
+    pType :: PlayerType,
+    score :: Integer
+} deriving (Show, Eq)
+
+data Game = Game {
+    playerA :: Player,
+    playerB :: Player,
+    pointsToWin :: Integer
+} deriving (Show, Eq)
+
+-- type Score = (Integer, Integer)
+
+type GameState = StateT Game IO
+
+isPlayerWinner :: (Game -> Player) -> Game -> Bool
+isPlayerWinner p g = (score . p) g >= pointsToWin g
+
+endGameMsg :: Bool -> Bool -> IO ()
+endGameMsg True True = putStrLn "Everybody is a winner!" >> exitSuccess
+endGameMsg True False = putStrLn "Player A is a winner!" >> exitSuccess
+endGameMsg False True = putStrLn "Player B is a winner!" >> exitSuccess
+endGameMsg _ _ = return ()
+
+gameEnd :: GameState ()
+gameEnd = do
+    g <- get
+    let pA = isPlayerWinner playerA g
+        pB = isPlayerWinner playerB g
+    liftIO $ endGameMsg pA pB
+    return ()
+
+handleHumanPlayer :: IO (Integer, Integer)
+handleHumanPlayer = do
+    putStr "Fingers and total (f, t): "
+    hFlush stdout
+    s <- getLine
+    clearScreen
+    case fmap fst . listToMaybe . reads $ s of
+        Nothing -> do
+            putStrLn "Incorrect format."
+            handleHumanPlayer
+        Just a -> return a
+
+handleAIPlayer :: Guesses -> Table -> IO (Integer, Integer)
+handleAIPlayer g t = do
+    f <- randomRIO (0,5)
+    g <- case M.lookup g t of
+        Nothing -> randomRIO (0, 5)
+        Just n -> return n
+    return (f, f + g)
+
+updateAI :: Player -> Integer -> Player
+updateAI p n = case pType p of
+    Human -> p
+    AI g@(g1, g2) t -> p { pType = AI g' t' }
+        where g' = (g2, n)
+              t' = M.insert g n t
+
+updateAIs :: (Integer, Integer) -> GameState ()
+updateAIs (gA, gB) = do
+    g <- get
+    let pA = playerA g
+        pB = playerB g
+        pA' = updateAI pA gB
+        pB' = updateAI pB gA
+        g' = g { playerA = pA' }
+    put $ g' { playerB = pB' }
+
+handlePlayer :: (Game -> Player) -> GameState (Integer, Integer)
+handlePlayer p = do
+    g <- get
+    let player = p g
+    case pType player of
+        Human -> liftIO handleHumanPlayer
+        AI g t -> liftIO $ handleAIPlayer g t
+
+handleGuessPlayerA :: Integer -> Integer -> GameState ()
+handleGuessPlayerA guess total =
+    if (guess == total)
+    then do
+        g <- get
+        let p = playerA g
+            s = score p
+        put $ g { playerA = (p { score = s + 1 })}
+        liftIO $ putStrLn $ "PlayerA guessed correctly!"
+    else return ()
+
+handleGuessPlayerB :: Integer -> Integer -> GameState ()
+handleGuessPlayerB guess total =
+    if (guess == total)
+    then do
+        g <- get
+        let p = playerB g
+            s = score p
+        put $ g { playerB = (p { score = s + 1 })}
+        liftIO $ putStrLn $ "PlayerB guessed correctly!"
+    else return ()
+
+runGame :: GameState ()
+runGame = forever $ do
+    gameEnd
+    liftIO $ putStrLn "Turn PlayerA"
+    (f, g) <- handlePlayer playerA
+    liftIO $ putStrLn "Turn PlayerB"
+    (f', g') <- handlePlayer playerB
+    let total = f + f'
+    liftIO $ do
+        putStrLn "=========================="
+        putStr $ "PlayerA showed: " ++ show f
+        putStrLn $ " and guessed: " ++ show g
+        putStr $ "PlayerB showed: " ++ show f'
+        putStrLn $ " and guessed: " ++ show g'
+        putStrLn $ "Total was: " ++ show total
+        putStrLn "=========================="
+    handleGuessPlayerA g total
+    handleGuessPlayerB g' total
+    liftIO $ putStrLn "=========================="
+    -- update any ai
+    updateAIs (f, f')
+    -- print the player status
+    g <- get
+    let pA = playerA g
+        pB = playerB g
+    liftIO $ do
+        putStrLn $ "PlayerA: " ++ show pA
+        putStrLn $ "PlayerB: " ++ show pB

26-monad-transformers/morra/morra.cabal

@@ -0,0 +1,33 @@
+name:                morra
+version:             0.1.0.0
+-- synopsis:
+-- description:
+homepage:            https://github.com/githubuser/morra#readme
+license:             BSD3
+license-file:        LICENSE
+author:              Author name here
+maintainer:          example@example.com
+copyright:           2018 Author name here
+category:            Web
+build-type:          Simple
+cabal-version:       >=1.10
+extra-source-files:  README.md
+
+library
+  hs-source-dirs:      lib
+  exposed-modules:     Morra
+  build-depends:       base >= 4.7 && < 5
+                     , transformers
+                     , random
+                     , ansi-terminal
+                     , containers
+  default-language:    Haskell2010
+
+executable morra
+  hs-source-dirs:      src
+  main-is:             Main.hs
+  default-language:    Haskell2010
+  build-depends:       base >= 4.7 && < 5
+                     , transformers
+                     , morra
+                     , containers

26-monad-transformers/morra/src/Main.hs

@@ -0,0 +1,17 @@
+module Main where
+
+import Morra
+import Control.Monad.Trans.State
+import qualified Data.Map as M
+
+initialGame :: Game
+initialGame = Game {
+  playerA = Player { pType = Human, score = 0 },
+  playerB = Player { pType = AI (0,0) M.empty, score = 0 },
+  pointsToWin = 3
+}
+
+main :: IO ()
+main = do
+  -- putStrLn "Woop"
+  evalStateT runGame initialGame

26-monad-transformers/morra/stack.yaml

@@ -0,0 +1,65 @@
+# This file was automatically generated by 'stack init'
+#
+# Some commonly used options have been documented as comments in this file.
+# For advanced use and comprehensive documentation of the format, please see:
+# https://docs.haskellstack.org/en/stable/yaml_configuration/
+
+# Resolver to choose a 'specific' stackage snapshot or a compiler version.
+# A snapshot resolver dictates the compiler version and the set of packages
+# to be used for project dependencies. For example:
+#
+# resolver: lts-3.5
+# resolver: nightly-2015-09-21
+# resolver: ghc-7.10.2
+# resolver: ghcjs-0.1.0_ghc-7.10.2
+#
+# The location of a snapshot can be provided as a file or url. Stack assumes
+# a snapshot provided as a file might change, whereas a url resource does not.
+#
+# resolver: ./custom-snapshot.yaml
+# resolver: https://example.com/snapshots/2018-01-01.yaml
+resolver: lts-11.12
+
+# User packages to be built.
+# Various formats can be used as shown in the example below.
+#
+# packages:
+# - some-directory
+# - https://example.com/foo/bar/baz-0.0.2.tar.gz
+# - location:
+#    git: https://github.com/commercialhaskell/stack.git
+#    commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
+# - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a
+#  subdirs:
+#  - auto-update
+#  - wai
+packages:
+- .
+# Dependency packages to be pulled from upstream that are not in the resolver
+# using the same syntax as the packages field.
+# (e.g., acme-missiles-0.3)
+# extra-deps: []
+
+# Override default flag values for local packages and extra-deps
+# flags: {}
+
+# Extra package databases containing global packages
+# extra-package-dbs: []
+
+# Control whether we use the GHC we find on the path
+# system-ghc: true
+#
+# Require a specific version of stack, using version ranges
+# require-stack-version: -any # Default
+# require-stack-version: ">=1.7"
+#
+# Override the architecture used by stack, especially useful on Windows
+# arch: i386
+# arch: x86_64
+#
+# Extra directories used by stack for building
+# extra-include-dirs: [/path/to/dir]
+# extra-lib-dirs: [/path/to/dir]
+#
+# Allow a newer minor version of GHC than the snapshot specifies
+# compiler-check: newer-minor

26-monad-transformers/src/EitherT.hs

@@ -0,0 +1,38 @@
+module EitherT where
+
+import Control.Monad.Trans.Class
+
+newtype EitherT e m a = EitherT { runEitherT :: m (Either e a) }
+
+
+instance Functor m => Functor (EitherT e m) where
+    fmap f (EitherT ma) = EitherT $ (fmap . fmap) f ma
+
+instance Applicative m => Applicative (EitherT e m) where
+    pure a = EitherT $ pure . pure $ a
+    (EitherT mf) <*> (EitherT ma) = EitherT $ (fmap (<*>) mf) <*> ma
+
+instance Monad m => Monad (EitherT e m) where
+    return = pure
+    (EitherT ma) >>= k = EitherT $ do
+        a <- ma
+        case a of
+            Right a' -> runEitherT $ k a'
+            Left e -> return $ Left e
+
+swapEither :: Either e a -> Either a e
+swapEither (Left e) = Right e
+swapEither (Right a) = Left a
+
+swapEitherT :: Functor m => EitherT e m a -> EitherT a m e
+swapEitherT (EitherT ma) = EitherT $ fmap swapEither ma
+
+eitherT :: Monad m => (a -> m c) -> (b -> m c) -> EitherT a m b -> m c
+eitherT f g (EitherT ma) = do
+    a <- ma
+    case a of
+        Left e -> f e
+        Right a' -> g a'
+
+instance MonadTrans (EitherT e) where
+    lift m = EitherT $ fmap Right m

26-monad-transformers/src/FixTheCode.hs

@@ -0,0 +1,23 @@
+module FixTheCode where
+
+import Control.Monad.Trans.Maybe
+import Control.Monad
+
+import Control.Monad.IO.Class
+
+isValid :: String -> Bool
+isValid v = '!' `elem` v
+
+maybeExcite :: MaybeT IO String
+maybeExcite = do
+    v <- liftIO getLine -- added liftIO
+    guard $ isValid v
+    return v
+
+doExcite :: IO ()
+doExcite = do
+    putStrLn "say something excite!"
+    excite <- runMaybeT maybeExcite -- added runMaybeT
+    case excite of
+        Nothing -> putStrLn "MOAR EXCITE"
+        Just e -> putStrLn $ "Good, was very excite: " ++ e

26-monad-transformers/src/Hypo.hs

@@ -0,0 +1,20 @@
+module Hypo where
+
+import Control.Monad.Trans.Reader
+import Control.Monad.Trans.Maybe
+
+-- r -> Maybe a
+foo :: Int -> ReaderT Int Maybe Int
+foo a = return a
+
+
+-- (Reader r) (Maybe a)
+-- r -> Maybe a
+bar :: Int -> MaybeT (Reader Int) Int
+bar a = return a
+
+-- looks pretty much the same to me...
+main :: IO ()
+main = do
+    print $ runReaderT (foo 1) 5
+    print $ runReader (runMaybeT (bar 1)) 5

26-monad-transformers/src/MaybeT.hs

@@ -0,0 +1,30 @@
+module MaybeT where
+
+import Control.Monad.Trans.Class
+import Control.Monad.IO.Class
+
+data MaybeT m a = MaybeT { runMaybeT :: m (Maybe a) }
+
+instance Functor m => Functor (MaybeT m) where
+    fmap f (MaybeT ma) = MaybeT $ (fmap . fmap) f ma
+
+instance Applicative m => Applicative (MaybeT m) where
+    pure = MaybeT . pure . Just
+
+    (MaybeT mf) <*> (MaybeT ma) = MaybeT $
+        (fmap (<*>) mf) <*> ma
+
+instance Monad m => Monad (MaybeT m) where
+    return = pure
+
+    (MaybeT ma) >>= k = MaybeT $ do
+        a <- ma
+        case a of
+            Nothing -> return Nothing
+            Just a' -> runMaybeT $ k a'
+
+instance MonadTrans (MaybeT) where
+    lift m = MaybeT $ fmap Just m
+
+instance MonadIO m => MonadIO (MaybeT m) where
+    liftIO = lift . liftIO

26-monad-transformers/src/Morra.hs

@@ -0,0 +1,102 @@
+module Morra where
+
+import Control.Monad (forever)
+import Control.Monad.Trans.State
+import Control.Monad.IO.Class
+
+
+import System.Exit (exitSuccess)
+import System.Random (randomRIO)
+
+-- Player chooses 0-5 and number
+-- AI chooses 0-5 and number
+
+pointsToWin :: Integer
+pointsToWin = 3
+
+type Score = (Integer, Integer)
+type GameState = StateT Score IO
+
+iWin :: Score -> Bool
+iWin = (>= pointsToWin) . fst
+
+aiWin :: Score -> Bool
+aiWin = (>= pointsToWin) . snd
+
+gameWin :: GameState ()
+gameWin = do
+    s <- get
+    if iWin s then
+        liftIO $ do
+            putStrLn "You win!"
+            exitSuccess
+    else return ()
+
+gameLose :: GameState ()
+gameLose = do
+    s <- get
+    if aiWin s then
+        liftIO $ do
+            putStrLn "AI wins!"
+            exitSuccess
+    else return ()
+
+getFingers :: IO Integer
+getFingers = do
+    putStrLn "How many fingers will you show (0-5)?"
+    response <- getLine
+    if response `elem` (map show [0..5])
+        then return $ read response
+        else getFingers
+
+getGuess :: IO Integer
+getGuess = do
+    putStrLn "How many fingers will be shown in total (0-10)?"
+    response <- getLine
+    if response `elem` (map show [0..10])
+        then return $ read response
+        else getGuess
+
+getAIData :: IO (Integer, Integer)
+getAIData = do
+    f <- randomRIO (0,5)
+    g <- randomRIO (0,5)
+    return (f, f + g)
+
+handleCorrectGuess :: GameState ()
+handleCorrectGuess = do
+    (hs,as) <- get
+    put (hs + 1, as)
+
+handleAICorrectGuess :: GameState ()
+handleAICorrectGuess = do
+    (hs, as) <- get
+    put (hs, as + 1)
+
+runGame :: GameState ()
+runGame = forever $ do
+    gameWin
+    gameLose
+    (f,g) <- liftIO $ do
+            f <- getFingers
+            g <- getGuess
+            return (f,g)
+    (f', g') <- liftIO getAIData
+    if f == g + g' then handleCorrectGuess else return ()
+    if f' == g + g' then handleAICorrectGuess else return ()
+    s <- get
+    liftIO $ do
+        putStrLn $ "=================="
+        putStrLn $ "AI showed: " ++ show f'
+        putStrLn $ "AI guessed: " ++ show g'
+        putStrLn $ "Total was: " ++  show (f + f')
+        putStrLn $ "------------------"
+        putStrLn $ "Score is: " ++ show s
+        putStrLn $ "=================="
+
+
+initialState :: Score
+initialState = (0, 0)
+
+main :: IO ()
+main = evalStateT runGame initialState

26-monad-transformers/src/ReaderT.hs

@@ -0,0 +1,28 @@
+module ReaderT where
+
+import Control.Monad.Trans.Class
+import Control.Monad.IO.Class
+
+data ReaderT r m a = ReaderT { runReaderT :: r -> m a }
+
+instance Functor m => Functor (ReaderT r m) where
+    fmap f (ReaderT rma) = ReaderT $ \r -> fmap f (rma r)
+
+instance Applicative m => Applicative (ReaderT r m) where
+    pure = ReaderT . const . pure
+
+    (ReaderT rmf) <*> (ReaderT rma) = ReaderT $ \r ->
+        (rmf r) <*> (rma r)
+
+instance Monad m => Monad (ReaderT r m) where
+    return = pure
+
+    (ReaderT rma) >>= k = ReaderT $ \r -> do
+        a <- rma r
+        runReaderT (k a) r
+
+instance MonadTrans (ReaderT r) where
+    lift = ReaderT . const
+
+instance MonadIO m => MonadIO (ReaderT r m) where
+    liftIO = lift . liftIO

26-monad-transformers/src/StateT.hs

@@ -0,0 +1,29 @@
+module StateT where
+
+import Control.Monad.Trans.Class
+import Control.Monad.IO.Class
+
+data StateT s m a = StateT { runStateT :: s -> m (a, s) }
+
+instance Functor m => Functor (StateT s m) where
+    fmap f st = StateT $ \s ->
+        fmap (\(a, s') -> (f a, s')) $ runStateT st s
+
+instance Monad m => Applicative (StateT s m) where
+    pure a = StateT $ \s -> pure (a, s)
+    stf <*> sta = StateT $ \s -> do
+        (f, s') <- runStateT stf s
+        (a, s'') <- runStateT sta s'
+        return (f a, s'')
+
+instance Monad m => Monad (StateT s m) where
+    return = pure
+    st >>= k = StateT $ \s -> do
+        (a, s') <- runStateT st s
+        runStateT (k a) s'
+
+instance MonadTrans (StateT s) where
+    lift m = StateT $ \s -> fmap (flip (,) s) m
+
+instance MonadIO m => MonadIO (StateT s m) where
+    liftIO = lift . liftIO

26-monad-transformers/src/WrapItUp.hs

@@ -0,0 +1,9 @@
+module WrapItUp where
+
+import Control.Monad.Trans.Maybe
+import Control.Monad.Trans.Except
+import Control.Monad.Trans.Reader
+
+embedded :: MaybeT (ExceptT String (ReaderT () IO)) Int
+embedded =
+    MaybeT (ExceptT (ReaderT (const $ return (Right (Just 1)))))

26-monad-transformers/src/WriteTheCode.hs

@@ -0,0 +1,44 @@
+module WriteTheCode where
+
+import Control.Monad.Trans.Reader
+import Control.Monad.Trans.State
+import Control.Monad.Identity
+
+import Control.Monad.IO.Class
+
+-- 1
+rDec :: Num a => Reader a a
+rDec = do
+    a <- ask
+    return $ a - 1
+
+-- 2
+rDec' :: Num a => Reader a a
+rDec' = ask >>= return . flip (-) 1
+
+-- 3
+rShow :: Show a => ReaderT a Identity String
+rShow = do
+    a <- ask
+    return $ show a
+
+-- 4
+rShow' :: Show a => ReaderT a Identity String
+rShow' = ask >>= return . show
+
+-- 5
+rPrintAndInc :: (Num a, Show a) => ReaderT a IO a
+rPrintAndInc = do
+    a <- ask
+    liftIO $ putStr "Hi: "
+    liftIO $ print a
+    return $ a + 1
+
+-- 6
+sPrintIncAccum :: (Num a, Show a) => StateT a IO String
+sPrintIncAccum = do
+    a <- get
+    liftIO $ putStr "Hi: "
+    liftIO $ print a
+    put (a + 1)
+    return $ show a