Last active
August 29, 2015 14:01
-
-
Save dtchepak/0dad0e6737c7f57fde1f to your computer and use it in GitHub Desktop.
Example of getting values out of a computation that are not explicitly passed to a function
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
import Control.Monad (foldM) | |
import Control.Applicative | |
-- Given an initial state return a value based on that state and the new state | |
newtype State s a = State { runState :: s -> (a, s) } | |
-- Get the value of the state | |
get :: State s s | |
get = State $ \s -> (s,s) | |
-- Put a value into the state | |
put :: s -> State s () | |
put x = State $ \_ -> ((), x) | |
-- `State a a` holds the sum of all numbers seen so far, | |
-- as well as a count of how many numbers we've summed. | |
-- sumAndCount represents one step of a stateful average computation. | |
-- | |
-- Given the current sum and a number `x`, return a state that represents | |
-- the addition of `x` to the current sum and increment of the count of numbers | |
-- we've summed so far. | |
-- | |
-- Note we don't explicitly get passed the count of numbers. This is read from | |
-- the state using `get`, and updated using `put` | |
sumAndCount :: Num a => a -> a -> State a a | |
sumAndCount sum x = do | |
count <- get -- read the state (how many numbers we've summed) | |
put (count + 1) -- update state to include this number | |
return $ sum + x -- | |
avg :: Fractional a => [a] -> a | |
avg xs = | |
let (sum, count) = runState (foldM sumAndCount 0 xs) 0 | |
in sum/count | |
-- Functor, Applicative and Monad instances | |
instance Monad (State s) where | |
return a = State $ \s -> (a,s) | |
st >>= f = State $ \s -> | |
let (a, s') = runState st s | |
in runState (f a) s' | |
instance Applicative (State s) where | |
pure = return | |
sf <*> sa = sf >>= \f -> fmap f sa | |
instance Functor (State s) where | |
fmap f st = st >>= return . f | |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment