1{-# LANGUAGE FlexibleContexts #-}
2{-# LANGUAGE TypeFamilies #-}
3{-# LANGUAGE DataKinds #-}
4{-# LANGUAGE TypeOperators #-}
5
6module Main where
7
8
9
10import Control.Monad.Trans.MultiState
11
12import Control.Applicative ( (<$>), (<*>) )
13
14import Control.Monad.Trans ( lift )
15import Control.Monad.Writer
16
17
18
19{-
20Small example showing
21  1) a MultiState containing a Char and a String,
22  2) the polymorphic mGet,
23  3) how to initially put values into the MultiState using withMultiState,
24  4) the type inference at work - note that there was no need to annotate
25     combinedPrint
26-}
27
28simpleExample :: IO ()
29simpleExample = runMultiStateTNil_
30              $ withMultiState 'H'              -- add a Char to the state
31              $ withMultiState "ello, World!" -- add a String to the state
32              $ do
33  -- the monad here is MultiStateT '[String, Char] IO
34  let combinedPrint = do
35        c  <- mGet
36        cs <- mGet
37        -- i <- mGet -- No instance for (Control.Monad.MultiState.ContainsType Int '[])
38        -- lift $ print $ (i :: Int)
39        lift $ putStrLn (c:cs)
40  combinedPrint
41  mSet 'J' -- we set the Char in the state to 'J'
42  combinedPrint
43
44-- output:
45--  "Hello, World!
46--   Jello, World!
47--  "
48
49-- and a more complex example:
50
51newtype Account = Account Float
52newtype Interest = Interest Float
53
54setAccount :: MonadMultiState Account m => Float -> m ()
55setAccount x = mSet (Account x)
56getAccount :: MonadMultiState Account m => m Float
57getAccount = do
58  (Account x) <- mGet
59  return x
60modAccount :: MonadMultiState Account m => (Float -> Float) -> m ()
61modAccount f = do
62  (Account x) <- mGet
63  mSet (Account (f x))
64
65-- wait for a specific time, changing the account according to interest
66wait :: ( MonadMultiState Account m
67        , MonadMultiState Interest m )
68     => Float
69     -> m ()
70wait t = do
71  (Interest i) <- mGet
72  (Account x) <- mGet
73  mSet (Account (x*(1+i)**t))
74
75logAccount :: ( MonadWriter [String] m
76              , MonadMultiState Account m)
77           => m ()
78logAccount = do
79  (Account x) <- mGet
80  tell $ ["account balance = " ++ show x]
81
82accountCalculation :: Writer [String] ()
83accountCalculation = runMultiStateTNil_ $ do
84  tell ["account calculation start"]
85  -- we cannot use any of the account methods here, because state is empty
86  -- logAccount
87  --   -->
88  --   No instance for (Control.Monad.MultiState.ContainsType Account '[])
89  withMultiState (Account 0.0) $ do -- state contains an Account.
90    logAccount
91    modAccount (+10.0)
92    logAccount
93    -- trying to use "wait" here would give type error, like above.
94    withMultiState (Interest 0.03) $ do -- state now also contains Interest.
95      wait 10.0 -- we can use wait, because state contains all
96                -- necessary stuff.
97      logAccount
98      modAccount (\x -> x - 10.0)
99      wait 10.0
100      logAccount
101      mSet (Interest 0.00)
102      wait 10.0
103    -- we can return back to the environment without interest
104    -- but the changes to the account are still present
105    logAccount
106  -- and we can return to an empty state
107  tell ["account calculation end"]
108
109main = do
110  simpleExample
111  mapM_ putStrLn $ execWriter accountCalculation
112
113
114-- whatIsNotPossible :: MultiStateT '[String] IO ()
115-- whatIsNotPossible = mGet >>= (lift . print) -- type ambiguous
116
117-- another thing that is not directly possible is the restriction to
118-- specific values, i.e. a function
119--  restrict :: MultiStateT xvalues m a -> MultiStateT yvalues m a
120-- where yvalues is a "superset" of xvalues.
121
122--TODO: example with mGetRaw and withMultiStates
123