
{-# LANGUAGE RebindableSyntax #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FlexibleContexts #-}

module Main ( main, write ) where

import Prelude
import qualified Control.Effect as E
import Control.Effect.State

ifThenElse :: Bool -> a -> a -> a
ifThenElse True  t e = t
ifThenElse False t e = e

main :: IO ()
main = do
  putStrLn $ show $ runState
    ( write "abc" )
    ( Ext (Var :-> 0 :! Eff) (Ext (Var :-> [] :! Eff) Empty) )

varC :: Var "count"
varC = Var
varS :: Var "out"
varS = Var

incC :: State '["count" :-> Int :! 'RW] Int
incC = do { x <- get varC; put varC (x + 1); return (x + 1) }
  where (>>=) :: (E.Inv State f g) => State f a -> (a -> State g b) -> State (E.Plus State f g) b
        (>>=) = (E.>>=)
        (>>) :: (E.Inv State f g) => State f a -> State g b -> State (E.Plus State f g) b
        (>>) = (E.>>)
        return :: a -> State '[] a
        return = E.return
        fail = E.fail

writeS :: [a] -> State '["out" :-> [a] :! 'RW] ()
writeS y = do { x <- get varS; put varS (x ++ y) }
  where (>>=) :: (E.Inv State f g) => State f a -> (a -> State g b) -> State (E.Plus State f g) b
        (>>=) = (E.>>=)
        (>>) :: (E.Inv State f g) => State f a -> State g b -> State (E.Plus State f g) b
        (>>) = (E.>>)
        return :: a -> State '[] a
        return = E.return
        fail = E.fail

write :: [a] -> State '["count" :-> Int :! 'RW, "out" :-> [a] :! 'RW] ()
write x = do { writeS x; _ <- incC; return () }
  where (>>=) :: (E.Inv State f g) => State f a -> (a -> State g b) -> State (E.Plus State f g) b
        (>>=) = (E.>>=)
        (>>) :: (E.Inv State f g) => State f a -> State g b -> State (E.Plus State f g) b
        (>>) = (E.>>)
        return :: a -> State '[] a
        return = E.return
        fail = E.fail
