content: {-# LANGUAGE ConstraintKinds #-}
  {-# LANGUAGE DataKinds #-}
  {-# LANGUAGE DeriveGeneric #-}
  {-# LANGUAGE DerivingVia #-}
  {-# LANGUAGE FlexibleContexts #-}
  {-# LANGUAGE FlexibleInstances #-}
  {-# LANGUAGE GeneralizedNewtypeDeriving #-}
  {-# LANGUAGE RankNTypes #-}
  {-# LANGUAGE TypeApplications #-}
  {-# LANGUAGE TypeInType #-}
  {-# LANGUAGE TypeOperators #-}
  
  -- | Example uses and instances of the @HasState@ capability.
  module State where
  
  import Capability.Reader
  import Capability.Sink
  import Capability.Source
  import Capability.State
  import Control.Monad.Reader (ReaderT (..))
  import Control.Monad.State.Strict (State, StateT (..), runState)
  import Data.IORef
  import GHC.Generics (Generic)
  import Test.Hspec
  
  ----------------------------------------------------------------------
  -- Example Programs
  
  incFoo :: HasState "foo" Int m => m ()
  incFoo = modify @"foo" (+1)
  
  incFoobar :: HasState "foobar" (Int,Int) m => m ()
  incFoobar = modify @"foobar" $ \(x,y) -> (x+1, y+1)
  
  twoStates :: (HasState "foo" Int m, HasState "bar" Int m) => m ()
  twoStates = do
    incFoo
    modify @"bar" (subtract 1)
  
  
  useZoom :: HasState "foobar" (Int, Int) m => m Int
  useZoom = do
    put @"foobar" (2, 2)
    -- Zoom in on the first element in the current state, renaming tag 1 to "foo",
    -- while retaining the original 'HasState "foobar" (Int, Int)' capability.
    zoom
      @"foo" @(Rename 1 :.: Pos 1 "foobar")
      @('[HasState "foobar" (Int,Int)]) $ do
        incFoo
        incFoobar
    gets @"foobar" (\(foo, bar) -> foo + bar)
  
  
  ----------------------------------------------------------------------
  -- Instances
  
  data TwoStates = TwoStates
    { tsFoo :: IORef Int
    , tsBar :: IORef Int
    } deriving Generic
  
  -- | Deriving @HasState@ from @HasReader@ of an @IORef@.
  --
  -- In this case two separate state capabilities are derived from the record
  -- fields of the @HasReader@ context.
  newtype TwoStatesM a = TwoStatesM (ReaderT TwoStates IO a)
    deriving (Functor, Applicative, Monad)
    deriving (HasSource "foo" Int, HasSink "foo" Int, HasState "foo" Int) via
      ReaderIORef (Rename "tsFoo" (Field "tsFoo" ()
      (MonadReader (ReaderT TwoStates IO))))
    deriving (HasSource "bar" Int, HasSink "bar" Int, HasState "bar" Int) via
      ReaderIORef (Rename "tsBar" (Field "tsBar" ()
      (MonadReader (ReaderT TwoStates IO))))
  
  runTwoStatesM :: TwoStatesM a -> IO (a, (Int, Int))
  runTwoStatesM (TwoStatesM m) = do
    fooRef <- newIORef 0
    barRef <- newIORef 0
    result <- runReaderT m TwoStates
      { tsFoo = fooRef
      , tsBar = barRef
      }
    fooVal <- readIORef fooRef
    barVal <- readIORef barRef
    pure (result, (fooVal, barVal))
  
  
  -- | Deriving two @HasState@ instances from the components of a tuple in
  -- @MonadState@.
  newtype PairStateM a = PairStateM (State (Int, Int) a)
    deriving (Functor, Applicative, Monad)
    deriving (HasSource "foo" Int, HasSink "foo" Int, HasState "foo" Int) via
      Rename 1 (Pos 1 () (MonadState (State (Int, Int))))
    deriving (HasSource "bar" Int, HasSink "bar" Int, HasState "bar" Int) via
      Rename 2 (Pos 2 () (MonadState (State (Int, Int))))
  
  runPairStateM :: PairStateM a -> (a, (Int, Int))
  runPairStateM (PairStateM m) = runState m (0, 0)
  
  
  -- | Combining the @HasState@ instances from two nested @StateT@ transformers.
  --
  -- Note, that this is not the recommended way to provide multiple `HasState`
  -- capabilities. Use the approach shown above in 'TwoStatesM' instead. However,
  -- this pattern can be useful to transation existing code to this library.
  newtype NestedStatesM a = NestedStatesM (StateT Int (State Int) a)
    deriving (Functor, Applicative, Monad)
    deriving (HasSource "foo" Int, HasSink "foo" Int, HasState "foo" Int) via
      MonadState (StateT Int (State Int))
    deriving (HasSource "bar" Int, HasSink "bar" Int, HasState "bar" Int) via
      Lift (StateT Int (MonadState (State Int)))
  
  runNestedStatesM :: NestedStatesM a -> ((a, Int), Int)
  runNestedStatesM (NestedStatesM m) = runState (runStateT m 0) 0
  
  
  runFooBarState
    :: (forall m. HasState "foobar" (Int, Int) m => m a)
    -> (Int, Int) -> (a, (Int, Int))
  runFooBarState (MonadState m) = runState m
  
  
  ----------------------------------------------------------------------
  -- Test Cases
  
  spec :: Spec
  spec = do
    describe "TwoStatesM" $
      it "evaluates twoStates" $
        runTwoStatesM twoStates `shouldReturn` ((), (1, -1))
    describe "PairStateM" $
      it "evaluates twoStates" $
        runPairStateM twoStates `shouldBe` ((), (1, -1))
    describe "NestedStatesM" $
      it "evaluates twoStates" $
        runNestedStatesM twoStates `shouldBe` (((), 1), -1)
    describe "runFooBarState" $
      it "evaluates useZoom" $
        runFooBarState useZoom (0, 0) `shouldBe` (7, (4, 3))
  