A transformerless State Monad implemtation

State.purs

module Main where

import Prelude
import Data.Tuple (Tuple(..), snd)
import Data.Monoid (class Monoid, mempty)
import Control.Monad.Eff.Console (logShow)
import TryPureScript (render, withConsole)

newtype State s a = State (s -> Tuple a s)

runState :: forall s a. State s a -> s -> Tuple a s
runState (State f) = f

instance functorState :: Functor (State s) where
  map f (State g) = State \s ->
    let Tuple a s' = g s 
    in Tuple (f a) s'

instance applyState :: Apply (State s) where 
  apply (State g) (State h) = State \s ->
    let Tuple f s' = g s
        Tuple a s'' = h s'
    in Tuple (f a) s''

instance applicativeState :: Applicative (State s) where
  pure a = State \s -> Tuple a s
  
instance bindState :: Bind (State s) where
  bind (State g) f = State \s ->
    let Tuple a s' = g s
        Tuple a' s'' = (runState (f a)) s'
    in Tuple a' s''
  
instance monadState :: Monad (State s)

put :: forall s. s -> State s Unit
put s = State \_ -> Tuple unit s

get :: forall s. State s s
get = State \s -> Tuple s s

main = render <=< withConsole $ do
  logShow $ runState (State (\s -> Tuple 1 s)) "@"
  logShow $ flip runState "@" $ (\x -> x + 1) <$> State \s -> Tuple 1 s
  logShow $ flip runState "@" $ (State \s -> Tuple (\x -> x + 2) s) <*> State \s -> Tuple 1 s
  logShow $ flip runState "@" $ pure (\x -> x + 3) <*> State \s -> Tuple 1 s
  logShow $ flip runState [1, 2, 3] $ do
    arr <- get
    put (arr <> [4])