state monad

State.hs

module SomeMonad where

import Control.Applicative (Applicative(..))
import Control.Monad (liftM, ap)

-- see this for more help: http://brandon.si/code/the-state-monad-a-tutorial-for-the-confused/

newtype State s a = State { runState :: s -> (a, s) }

instance Monad (State s) where
    return x = State $ \s -> (x, s)
    a >>= fn = State $ \s -> let
            (a', s') = runState a s
        in runState (fn a') s'

instance Applicative (State s) where
    pure x = State $ \s -> (x, s)
    (<*>) = ap

instance Functor (State s) where
     fmap = liftM

push :: s -> State [s] ()
push a = State $ \s -> ((), a:s)

get :: State s s
get = State $ \s -> (s, s)

dostuff :: State [Int] ()
dostuff = do
    push 5
    push 10
    k <- get
    push $ sum k

main = do
    print $ runState dostuff [1]

StateClass.hs

{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-}

module SomeMonad where

import Control.Applicative (Applicative(..))
import Control.Monad (liftM, ap)


newtype State s a = State { runState :: s -> (a, s) }

class Monad m => MonadState s m | m -> s where

    get :: m s
    put :: s -> m ()
    modify :: (s->s) -> m ()

instance Monad (State s) where
    return x = State $ \s -> (x, s)
    a >>= fn = State $ \s -> let
            (a', s') = runState a s
        in runState (fn a') s'

instance Applicative (State s) where
    pure x = State $ \s -> (x, s)
    (<*>) = ap

instance Functor (State s) where
     fmap = liftM


instance MonadState s (State s) where
    get = State $ \s -> (s,s)
    put s = State $ \_ -> ((), s)
    modify fn = State $ \s -> ((), fn s)


dostuff :: State Int ()
dostuff = do
    put 5
    k <- get
    modify ( + 1)

main = do
    print $ runState dostuff 0

StateProcess.hs

{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}

module SomeMonad where

import Control.Applicative (Applicative(..))
import Control.Monad (liftM, ap, forM_)
import GHC.Generics
import Data.ByteString.Lazy hiding (map, pack)
import Data.ByteString.Lazy.Char8 hiding (map)
import Data.Aeson (eitherDecode, FromJSON)
import Data.Either


newtype State s a = State { runState :: s -> (a, s) }

instance Monad (State s) where
    return x = State $ \s -> (x, s)
    a >>= fn = State $ \s -> let
            (a', s') = runState a s
        in runState (fn a') s'

instance Applicative (State s) where
    pure x = State $ \s -> (x, s)
    (<*>) = ap

instance Functor (State s) where
     fmap = liftM

--------------------

data Queue a = Queue { rejected :: [a], failed :: [a] } deriving Show

class Monad m => MonadBatchHandler s m | m -> s where

    reject :: s -> m ()
    failure :: s -> m ()

instance MonadBatchHandler s (State (Queue s)) where
    reject k = State $ \(Queue r f) -> ((), Queue (k:r) f)
    failure k = State $ \(Queue r f) -> ((), Queue r (k:f))

---------------------

data Coord = Coord { x :: Double, y :: Double } deriving (Generic, Show)
instance FromJSON Coord
instance Monoid Coord where
    mempty = Coord 0 0
    (Coord x y) `mappend` (Coord x2 y2) = Coord (x + x2) (y + y2)

--------------------

type HandlerContext = State (Queue (String, String))

inputs :: [ByteString]
inputs = map pack [
     "{\"x\": 1, \"y\": 2}",
     "{\"xxxx\": 1, \"y\": 2}",
     "{\"x\": 3, \"y\": 2}"
    ]

decodeinputs :: [ByteString] -> HandlerContext [Coord]
decodeinputs is = do
    let ecoords = map eitherDecode is
    let (lefts, rights) = (partitionEithers ecoords) :: ([String]  , [Coord])
    -- forM_ lefts reject
    reject ("a", Prelude.head lefts)
    return rights

reduceCoords :: [Coord] -> HandlerContext Coord
reduceCoords cs = return $ mconcat cs

process :: [ByteString] -> HandlerContext Coord
process inputs = do
    coord <- decodeinputs inputs >>= reduceCoords
    return coord

main = do
    print $ runState (process inputs)  (Queue [] [])