-- |
-- As keys are looked up in maps, dynamic parsed placeholders are collected as a list of 'Dynamic's.
module Web.Route.Invertible.Dynamics
  ( Dynamics
  , DynamicState
  , DynamicResult
  , getDynamic
  ) where

import Data.Dynamic (Dynamic, fromDyn)
import Data.Typeable (Typeable)
import Control.Monad.Trans.State (StateT(..), State)

-- |Uncons the current state, leaving the tail in the state and returning the head.
-- (This should probably be moved to some other module.)
unconsState' :: State [a] a
unconsState' :: State [a] a
unconsState' = ([a] -> Identity (a, [a])) -> State [a] a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT (([a] -> Identity (a, [a])) -> State [a] a)
-> ([a] -> Identity (a, [a])) -> State [a] a
forall a b. (a -> b) -> a -> b
$ \(~(a
x:[a]
l)) -> (a, [a]) -> Identity (a, [a])
forall (m :: * -> *) a. Monad m => a -> m a
return (a
x, [a]
l)

type Dynamics = [Dynamic]
type DynamicState = State Dynamics
type DynamicResult a = (Dynamics, a)

getDynamic :: Typeable a => DynamicState a
getDynamic :: DynamicState a
getDynamic = (Dynamic -> a -> a
forall a. Typeable a => Dynamic -> a -> a
`fromDyn` [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"Web.Route.Invertible.getDynamic: internal type error") (Dynamic -> a)
-> StateT [Dynamic] Identity Dynamic -> DynamicState a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT [Dynamic] Identity Dynamic
forall a. State [a] a
unconsState'