-- |
-- Module      : FULE.LayoutOp
-- Description : @LayoutDesign@ creation helpers.
-- Copyright   : (c) Paul Schnapp, 2023
-- License     : BSD3
-- Maintainer  : Paul Schnapp <paul.schnapp@gmail.com>
--
-- Operations for constructing a 'FULE.Layout.LayoutDesign'.
module FULE.LayoutOp
 ( LayoutOp
 , LayoutOpState
 , runLayoutOp
 , addGuideToLayout
 , addGuideConstraintToLayout
 , nextRenderGroup
 ) where

import Control.Monad.Trans.State
import Control.Monad.Writer

import FULE.Component
import FULE.Layout


-- | Internal.
data LayoutOpState
  = LOS
    { LayoutOpState -> LayoutDesign
builderOf :: LayoutDesign
    , LayoutOpState -> Int
currentRenderGroupOf :: Int
    }

-- | An operation that will produce a 'FULE.Layout.LayoutDesign' and a list of
--   components of type @k@ in the monad @m@.
type LayoutOp k m = StateT LayoutOpState (WriterT [ComponentInfo k] m)

-- | Run a 'LayoutOp' to create a 'FULE.Layout.LayoutDesign' and a list of
--   components of type @k@.
runLayoutOp :: (Monad m) => LayoutOp k m () -> m (LayoutDesign, [ComponentInfo k])
runLayoutOp :: forall (m :: * -> *) k.
Monad m =>
LayoutOp k m () -> m (LayoutDesign, [ComponentInfo k])
runLayoutOp = ((LayoutOpState, [ComponentInfo k])
-> (LayoutDesign, [ComponentInfo k])
forall {b}. (LayoutOpState, b) -> (LayoutDesign, b)
toOutput ((LayoutOpState, [ComponentInfo k])
 -> (LayoutDesign, [ComponentInfo k]))
-> m (LayoutOpState, [ComponentInfo k])
-> m (LayoutDesign, [ComponentInfo k])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (m (LayoutOpState, [ComponentInfo k])
 -> m (LayoutDesign, [ComponentInfo k]))
-> (LayoutOp k m () -> m (LayoutOpState, [ComponentInfo k]))
-> LayoutOp k m ()
-> m (LayoutDesign, [ComponentInfo k])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterT [ComponentInfo k] m LayoutOpState
-> m (LayoutOpState, [ComponentInfo k])
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT (WriterT [ComponentInfo k] m LayoutOpState
 -> m (LayoutOpState, [ComponentInfo k]))
-> (LayoutOp k m () -> WriterT [ComponentInfo k] m LayoutOpState)
-> LayoutOp k m ()
-> m (LayoutOpState, [ComponentInfo k])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LayoutOp k m ()
-> LayoutOpState -> WriterT [ComponentInfo k] m LayoutOpState
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
`execStateT` LayoutDesign -> Int -> LayoutOpState
LOS LayoutDesign
emptyLayoutDesign Int
0)
  where toOutput :: (LayoutOpState, b) -> (LayoutDesign, b)
toOutput (LOS LayoutDesign
builder Int
_, b
components) = (LayoutDesign
builder, b
components)

-- | Add a Guide to the 'FULE.Layout.LayoutDesign'.
addGuideToLayout :: (Monad m) => GuideSpecification -> LayoutOp k m GuideID
addGuideToLayout :: forall (m :: * -> *) k.
Monad m =>
GuideSpecification -> LayoutOp k m GuideID
addGuideToLayout GuideSpecification
r = do
  LayoutOpState
state <- StateT LayoutOpState (WriterT [ComponentInfo k] m) LayoutOpState
forall (m :: * -> *) s. Monad m => StateT s m s
get
  let (GuideID
guideID, LayoutDesign
builder) = GuideSpecification -> LayoutDesign -> (GuideID, LayoutDesign)
addGuide GuideSpecification
r (LayoutOpState -> LayoutDesign
builderOf LayoutOpState
state)
  LayoutOpState
-> StateT LayoutOpState (WriterT [ComponentInfo k] m) ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put LayoutOpState
state { builderOf = builder }
  GuideID -> LayoutOp k m GuideID
forall a. a -> StateT LayoutOpState (WriterT [ComponentInfo k] m) a
forall (m :: * -> *) a. Monad m => a -> m a
return GuideID
guideID

-- | Add a Guide constraint to the 'FULE.Layout.LayoutDesign'.
addGuideConstraintToLayout
  :: (Monad m)
  => GuideConstraint -> LayoutOp k m ()
addGuideConstraintToLayout :: forall (m :: * -> *) k.
Monad m =>
GuideConstraint -> LayoutOp k m ()
addGuideConstraintToLayout GuideConstraint
constraint = do
  LayoutOpState
state <- StateT LayoutOpState (WriterT [ComponentInfo k] m) LayoutOpState
forall (m :: * -> *) s. Monad m => StateT s m s
get
  let builder :: LayoutDesign
builder = GuideConstraint -> LayoutDesign -> LayoutDesign
addGuideConstraint GuideConstraint
constraint (LayoutOpState -> LayoutDesign
builderOf LayoutOpState
state)
  LayoutOpState -> LayoutOp k m ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put LayoutOpState
state { builderOf = builder }

-- | Get the next available render group from the 'LayoutOp' state and advance
--   to the next one internally.
nextRenderGroup :: (Monad m) => LayoutOp k m Int
nextRenderGroup :: forall (m :: * -> *) k. Monad m => LayoutOp k m Int
nextRenderGroup = do
  LayoutOpState
state <- StateT LayoutOpState (WriterT [ComponentInfo k] m) LayoutOpState
forall (m :: * -> *) s. Monad m => StateT s m s
get
  let renderGroup :: Int
renderGroup = LayoutOpState -> Int
currentRenderGroupOf LayoutOpState
state
  LayoutOpState
-> StateT LayoutOpState (WriterT [ComponentInfo k] m) ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put LayoutOpState
state { currentRenderGroupOf = renderGroup + 1 }
  Int -> LayoutOp k m Int
forall a. a -> StateT LayoutOpState (WriterT [ComponentInfo k] m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
renderGroup