{-# language GeneralizedNewtypeDeriving #-}
{-# language DeriveFunctor #-}
{-# language FlexibleInstances #-}
{-# language FlexibleContexts #-}
{-# language MultiParamTypeClasses #-}
{-# language RankNTypes #-}
{-# language TypeFamilies #-}
{-# language UndecidableInstances #-}
{-# language ScopedTypeVariables #-}
module Eve.Internal.Actions
  ( AppF(..)
  , ActionT(..)
  , AppT

  , runEve
  , evalEve
  , execEve

  , runApp
  , runAction
  , runActionOver
  ) where

import Eve.Internal.States
import Control.Monad.State
import Control.Monad.Trans.Free
import Control.Lens
import Data.Typeable
import Data.Default

-- | An 'App' has the same base and zoomed values.
type AppT s m a = ActionT s s m a

-- | A Free Functor for storing lifted App actions.
newtype AppF base m next =
  RunApp (StateT base m next)
  deriving (Functor, Applicative)

-- | Base Action type. Allows paramaterization over application state, zoomed state
-- and underlying monad.
newtype ActionT base zoomed m a = ActionT
  { getAction :: FreeT (AppF base m) (StateT zoomed m) a
  } deriving (Functor, Applicative, Monad, MonadIO, MonadState zoomed)

instance (Monoid a, Monad m) => Monoid (ActionT base zoomed m a) where
  mempty = return mempty
  a `mappend` b = do
    a' <- a
    b' <- b
    return $ a' `mappend` b'

instance Monad n => MonadFree (AppF base n) (ActionT base zoomed n) where
  wrap (RunApp act) = join . ActionT . liftF . RunApp $ act

instance MonadTrans (ActionT base zoomed) where
  lift = ActionT . lift . lift

-- | Helper method to run FreeTs.
unLift :: Monad m => FreeT (AppF base m) (StateT base m) a -> StateT base m a
unLift m = do
  step <- runFreeT m
  case step of
    Pure a -> return a
    Free (RunApp next) -> next >>= unLift

-- | Allows 'zoom'ing 'Action's.
type instance Zoomed (ActionT base zoomed m) = Zoomed (FreeT (AppF base m) (StateT zoomed m))
instance Monad m => Zoom (ActionT base s m) (ActionT base t m) s t where
  zoom l (ActionT action) = ActionT $ zoom l action

-- | This runs an `Action MyState a` over the MyState which is
-- stored in the currently focused state and returns the result.
-- Use 'runActionOver' if you'd like to specify a particular MyState
-- which is accessed by a Lens or Traversal.
runAction :: (HasStates t, Functor (Zoomed m c), Default s, Typeable s, Zoom m n s t) => m c -> n c
runAction = zoom stateLens

-- | Given a 'Lens' or 'Traversal' or LensLike from "Control.Lens"
-- which focuses the state (t) of an 'Action' from a base state (s),
-- this will convert @Action t a -> Action s a@ so that it may be run
-- in an @Action s a@
runActionOver :: Zoom m n s t => LensLike' (Zoomed m c) t s -> m c -> n c
runActionOver = zoom

-- | Allows you to run an 'App' inside of an 'Action'
runApp :: Monad m => AppT base m a -> ActionT base zoomed m a
runApp = liftF .  RunApp . unLift . getAction

-- | Runs an application and returns the value and state.
runEve :: Monad m => base -> AppT base m a -> m (a, base)
runEve baseState = flip runStateT baseState . unLift . getAction

-- | Runs an application and returns the resulting value.
evalEve :: Monad m => base -> AppT base m a -> m a
evalEve baseState = fmap fst . runEve baseState

-- | Runs an application and returns the resulting state.
execEve :: Monad m => base -> AppT base m a -> m base
execEve baseState = fmap snd . runEve baseState