Code from Functional Brighton 18 July 2017

moremonads.hs

import Data.Monoid
import Data.Ratio
import Control.Monad.Writer
import Control.Monad.Reader
import Control.Monad.State

-- Maybe is for values with an added context of failure

fruit :: Maybe String
fruit = Just "Apple"

enhance :: String -> Maybe String
enhance "Apple" = Just "Toffee Apple"
enhance other   = Nothing

--
-- Remember:
-- Bind is about sequencing computations
--

-- the Writer monad is for values that have another value attached that acts as a sort of log value

{-
isBigGang :: Int -> Bool  
isBigGang x = x > 9 
-}

isBigGang :: Int -> (Bool, String)  
isBigGang x = (x > 9, "Compared gang size to 9.")  


-- Now what if we already have a value that has a log string attached to it, such as (3, "Smallish gang."), and we want to feed it to isBigGang?

applyLog :: (a,String) -> (a -> (b,String)) -> (b,String)  
applyLog (x,log) f = (y, log ++ newLog)
  where (y,newLog) = f x

{-
Right now, applyLog takes values of type (a,String), but is there a reason that the log has to be a String? It uses ++ to append the logs, so wouldn't this work on any kind of list, not just a list of characters?
-}

applyLog2 :: (a,[c]) -> (a -> (b,[c])) -> (b,[c])  
applyLog2 (x,log) f = (y, log ++ newLog)
  where (y,newLog) = f x
  

-- we can also generaize the ++ to a monoid append
applyLog3 :: (Monoid m) => (a,m) -> (a -> (b,m)) -> (b,m)  
applyLog3 (x,log) f = (y,log `mappend` newLog)  
  where (y,newLog) = f x
   

-- the attached value doesn't always have to be a log
  
type Food = String  
type Price = Sum Int  
  
addDrink :: Food -> (Food,Price)  
addDrink "beans" = ("milk", Sum 25)  
addDrink "jerky" = ("whiskey", Sum 99)  
addDrink _ = ("beer", Sum 30) 

-- Because the value that addDrink returns is a tuple of type (Food,Price), we can feed that result to addDrink again

-- Look at definition of Writer and Monad instannce
-- Is this it?
-- https://stackoverflow.com/questions/11684321/how-to-play-with-control-monad-writer-in-haskell
-- https://hackage.haskell.org/package/mtl-2.2.1/docs/Control-Monad-Writer-Lazy.html

-- newtype Writer w a = Writer { runWriter :: (a, w) }  


logNumber :: Int -> Writer [String] Int
--logNumber x = writer (x, ["Got number: " ++ show x])

logNumber x = do
  tell ["I saw "++(show x)]
  return x
  
multWithLog :: Writer [String] Int  
multWithLog = do  
    a <- logNumber 3  
    b <- logNumber 5  
    tell ["Gonna multiply these two"]
    (x,y) <- listen $ logNumber 30
    tell ["Listen result", show x, show y]        
    return (a*b)


--
-- Reader
--
-- We see that the reader monad allows us to treat functions as values with a context.
-- Monad.Instances is deprecated

addStuff :: Int -> Int
addStuff = do  
    a <- (*2)  
    b <- (+10)  
    return (a+b)
    
{-
 instance Monad ((->) r) where  
    return x = \_ -> x  
    h >>= f = \w -> f (h w) w
 -}

-- the function monad is also called the reader monad
--  We can act as if we already know what the functions will return. It does this by gluing functions together into one function and then giving that function's parameter to all of the functions that it was glued from


type Env = (String, Int)
env :: Env
env = ("localhost", 80)

-- http://hackage.haskell.org/package/mtl-1.1.0.2/docs/Control-Monad-Reader.html

isDeveloper :: Reader Env Bool
isDeveloper = do
  (host, _) <- ask
  secure    <- asks isSecure2
  -- secure    <- isSecure
  return $ (not secure) && (host == "localhost" || host == "127.0.0.1")


isSecure2 :: Env -> Bool
isSecure2 (_, 443) = True
isSecure2  _       = False

isSecure :: Reader Env Bool
isSecure = do
  (_, port) <- ask
  return $ port == 443

--
-- State
-- s -> (a,s)  
-- s is the type of the state and a the result of the stateful computations.

type Stack = [Int]

-- constructor takes a "run state" function as an argument:
-- s -> (a, s)

-- mote (possily the name for a value is a monad)

pop :: State Stack Int  
pop = state $ \(x:xs) -> (x,xs)  

-- Computation happens in the context of state
  
push :: Int -> State Stack ()  
push a = state $ \xs -> ((),a:xs)  


stackManip :: State Stack Int  
stackManip = do    
    a <- pop  
    b <- pop
    push (a * b)
    r <- pop
    return r  
    
-- (>>=) :: State s a -> (a -> State s b) -> State s b  
 
get2 = state $ \s -> (s,s)
put2 v = state $ \s -> ((), v)

stackyStack :: State Stack ()  
stackyStack = do  
    stackNow <- get2
    if stackNow == [1,2,3]  
        then put2 [8,3,1]  
        else put2 [9,2,1] 



--
-- Error
--

{-
instance (Error e) => Monad (Either e) where  
    return x = Right x   
    Right x  >>= f = f x  
    Left err >>= f = Left err  
    fail msg = Left (strMsg msg)  
-}

e :: Either String Int
e = Left "Bad Integer"

s :: Either String Int
s = Right 42



--
-- Friends
--

-- even though every monad is a functor, we don't have to rely on it having a Functor instance because of the liftM function. liftM takes a function and a monadic value and maps it over the monadic value. So it's pretty much the same thing as fmap! 

{-
join :: (Monad m) => m (m a) -> m a  
join mm = do  
    m <- mm  
    m  
    
In other words, 
m >>= f is always the same thing as join (fmap f m)!
-}

keepSmall :: Int -> Writer [String] Bool  
keepSmall x  
    | x < 4 = do  
        tell ["Keeping " ++ show x]  
        return True  
    | otherwise = do  
        tell [show x ++ " is too large, throwing it away"]  
        return False  

{-
filterM :: (Monad m) => (a -> m Bool) -> [a] -> m [a]  
-}


--binSmalls :: Int -> Int -> Maybe Int  
binSmalls acc x  
    | x > 9     = mzero  
    | otherwise = pure (acc + x)
    
foo = foldM binSmalls 0 [2,8,300,1]

newtype Prob a = Prob { getProb :: [(a,Rational)] } deriving Show

instance Functor Prob where
  fmap f (Prob xs) = Prob $ map (\(x,p) -> (f x,p)) xs

instance Applicative Prob where
  (<*>) = ap
  pure  = return
  
flatten :: Prob (Prob a) -> Prob a  
flatten (Prob xs) = Prob $ concat $ map multAll xs  
    where multAll (Prob innerxs,p) = map (\(x,r) -> (x,p*r)) innerxs
    
instance Monad Prob where  
    return x = Prob [(x,1%1)]  
    m >>= f  = flatten (fmap f m)  
    fail _ = Prob []
    
data Coin = Heads | Tails deriving (Show, Eq)  
  
coin :: Prob Coin  
coin = Prob [(Heads,1%2),(Tails,1%2)]  
  
loadedCoin :: Prob Coin  
loadedCoin = Prob [(Heads,1%10),(Tails,9%10)] 

flipThree :: Prob Bool  
flipThree = do  
    a <- coin  
    b <- coin  
    c <- loadedCoin  
    return (all (==Tails) [a,b,c])