{-# LANGUAGE MultiParamTypeClasses #-}


data State s a = State (s -> (a, s))

instance Functor (State s) where
  fmap f (State g) = State $ \s -> case g s of
                                     (a, s') -> (f a, s')

instance Monad (State s) where
  return x = State $ \s -> (x, s)
  State func >>= f = State $ \s -> case func s of
                                       (val, s') -> case f val of
                                                      State func' -> func' s'

instance Applicative (State s) where
  pure = return
  a <*> b = do
     f <- a
     x <- b
     return (f x)



class MonadState m s where
   get :: m s s
   put :: s -> m s ()


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

type StackProgram a = State [Int] a

push :: Int -> StackProgram ()
push x = do
  stack <- get
  put (x:stack)

put :: StackProgram Int
put = do
  stack <- get
  put (tail stack)
  return (head stack)

example :: StackProgram Int
example = do
  push 2
  push 3
  a <- pop
  b <- pop
  push (a + b)
  pop


newtype DBOp s a = DBOp (s -> IO (s, a))

instance Functor (DBOp s) where
  fmap f (DBOp g) = DBOp $ \s -> case g s of
                                     (a, s') -> (f a, s')

instance Monad (DBOp s) where
  return x = DBOp $ \s -> return (x, s)
  DBOp func >>= f = DBOp $ \s -> func s >>= \res -> case res of
                                                     (val, s') -> f val >>= \res' -> case res' of
                                                                                      DBOp func' -> func' s

instance Applicative (DBOp s) where
  pure = return
  a <*> b = do
     f <- a
     x <- b
     return (f x)

instance MonadState DBOp s where
  get = DBOp $ \s -> return (s, s)
  put s = DBOp $ \_ -> return (s, ())


connect :: String -> DBOp Connection ()
connect = undefined

update :: String -> String -> DBOp Connection ()
update = undefined

get :: String -> DBOp Connection [String]
get = undefined