-- |
-- An efficient map for sequences.
-- This is the core of the routing infrastructure.
-- If you have a set of routes represented as 'Sequence's, you can create a routing table using 'mconcat' and 'singletonSequenceApp':
-- 
-- >>> :set -XOverloadedStrings
-- >>> import Control.Invertible.Monoidal
-- >>> import Web.Route.Invertible.Parameter
-- >>> let p1 = "item" *< parameter :: Sequence String Int
-- >>> let p2 = "object" *< parameter :: Sequence String String
-- >>> let r = mconcat [singletonSequenceApp p1 [Left], singletonSequenceApp p2 [Right] {- ... -}] :: SequenceMapApp String [] (Either Int String)
-- >>> lookupSequenceApp ["object", "foo"] r
-- [Right "foo"]
-- >>> lookupSequenceApp ["item", "123"] r
-- [Left 123]
-- >>> lookupSequenceApp ["item", "bar"] r
-- []
--
{-# LANGUAGE GADTs, ScopedTypeVariables #-}
module Web.Route.Invertible.Map.Sequence
  ( SequenceMap(..)
  , singletonSequence
  , lookupSequence
  -- * Example usage
  , SequenceMapApp
  , singletonSequenceApp
  , lookupSequenceApp
  ) where

import Prelude hiding (lookup)

import Control.Applicative (Alternative(..))
import Control.Invertible.Monoidal.Free
import Control.Monad (MonadPlus(..))
import Control.Monad.Trans.State (evalState)
import Data.Semigroup (Semigroup((<>)))

import Web.Route.Invertible.String
import Web.Route.Invertible.Placeholder
import Web.Route.Invertible.Sequence
import Web.Route.Invertible.Dynamics
import Web.Route.Invertible.Map.Placeholder

-- |A routing map for 'Sequence' parsers.
-- Each joined ('Control.Invertible.Monoidal.>*<') component in the 'Sequence' becomes a level of the map.
data SequenceMap s a = SequenceMap
  { SequenceMap s a -> PlaceholderMap s (SequenceMap s a)
sequenceMapPlaceholder :: PlaceholderMap s (SequenceMap s a)
  , SequenceMap s a -> Maybe a
sequenceMapValue :: !(Maybe a)
  } deriving (SequenceMap s a -> SequenceMap s a -> Bool
(SequenceMap s a -> SequenceMap s a -> Bool)
-> (SequenceMap s a -> SequenceMap s a -> Bool)
-> Eq (SequenceMap s a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall s a.
(Eq s, Eq a) =>
SequenceMap s a -> SequenceMap s a -> Bool
/= :: SequenceMap s a -> SequenceMap s a -> Bool
$c/= :: forall s a.
(Eq s, Eq a) =>
SequenceMap s a -> SequenceMap s a -> Bool
== :: SequenceMap s a -> SequenceMap s a -> Bool
$c== :: forall s a.
(Eq s, Eq a) =>
SequenceMap s a -> SequenceMap s a -> Bool
Eq, Int -> SequenceMap s a -> ShowS
[SequenceMap s a] -> ShowS
SequenceMap s a -> String
(Int -> SequenceMap s a -> ShowS)
-> (SequenceMap s a -> String)
-> ([SequenceMap s a] -> ShowS)
-> Show (SequenceMap s a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall s a. (Show s, Show a) => Int -> SequenceMap s a -> ShowS
forall s a. (Show s, Show a) => [SequenceMap s a] -> ShowS
forall s a. (Show s, Show a) => SequenceMap s a -> String
showList :: [SequenceMap s a] -> ShowS
$cshowList :: forall s a. (Show s, Show a) => [SequenceMap s a] -> ShowS
show :: SequenceMap s a -> String
$cshow :: forall s a. (Show s, Show a) => SequenceMap s a -> String
showsPrec :: Int -> SequenceMap s a -> ShowS
$cshowsPrec :: forall s a. (Show s, Show a) => Int -> SequenceMap s a -> ShowS
Show)

unionSequenceWith :: RouteString s => (Maybe a -> Maybe a -> Maybe a) -> SequenceMap s a -> SequenceMap s a -> SequenceMap s a
unionSequenceWith :: (Maybe a -> Maybe a -> Maybe a)
-> SequenceMap s a -> SequenceMap s a -> SequenceMap s a
unionSequenceWith Maybe a -> Maybe a -> Maybe a
f (SequenceMap PlaceholderMap s (SequenceMap s a)
m1 Maybe a
v1) (SequenceMap PlaceholderMap s (SequenceMap s a)
m2 Maybe a
v2) =
  PlaceholderMap s (SequenceMap s a) -> Maybe a -> SequenceMap s a
forall s a.
PlaceholderMap s (SequenceMap s a) -> Maybe a -> SequenceMap s a
SequenceMap ((SequenceMap s a -> SequenceMap s a -> SequenceMap s a)
-> PlaceholderMap s (SequenceMap s a)
-> PlaceholderMap s (SequenceMap s a)
-> PlaceholderMap s (SequenceMap s a)
forall s a.
RouteString s =>
(a -> a -> a)
-> PlaceholderMap s a -> PlaceholderMap s a -> PlaceholderMap s a
unionPlaceholderWith ((Maybe a -> Maybe a -> Maybe a)
-> SequenceMap s a -> SequenceMap s a -> SequenceMap s a
forall s a.
RouteString s =>
(Maybe a -> Maybe a -> Maybe a)
-> SequenceMap s a -> SequenceMap s a -> SequenceMap s a
unionSequenceWith Maybe a -> Maybe a -> Maybe a
f) PlaceholderMap s (SequenceMap s a)
m1 PlaceholderMap s (SequenceMap s a)
m2) (Maybe a -> Maybe a -> Maybe a
f Maybe a
v1 Maybe a
v2)

instance (RouteString s, Semigroup a) => Semigroup (SequenceMap s a) where
  <> :: SequenceMap s a -> SequenceMap s a -> SequenceMap s a
(<>) = (Maybe a -> Maybe a -> Maybe a)
-> SequenceMap s a -> SequenceMap s a -> SequenceMap s a
forall s a.
RouteString s =>
(Maybe a -> Maybe a -> Maybe a)
-> SequenceMap s a -> SequenceMap s a -> SequenceMap s a
unionSequenceWith Maybe a -> Maybe a -> Maybe a
forall a. Semigroup a => a -> a -> a
(<>)

-- |Values are combined using 'mappend'.
instance (RouteString s, Monoid a) => Monoid (SequenceMap s a) where
  mempty :: SequenceMap s a
mempty = SequenceMap s a
forall (f :: * -> *) a. Alternative f => f a
empty
  mappend :: SequenceMap s a -> SequenceMap s a -> SequenceMap s a
mappend = (Maybe a -> Maybe a -> Maybe a)
-> SequenceMap s a -> SequenceMap s a -> SequenceMap s a
forall s a.
RouteString s =>
(Maybe a -> Maybe a -> Maybe a)
-> SequenceMap s a -> SequenceMap s a -> SequenceMap s a
unionSequenceWith Maybe a -> Maybe a -> Maybe a
forall a. Monoid a => a -> a -> a
mappend

instance Functor (SequenceMap s) where
  fmap :: (a -> b) -> SequenceMap s a -> SequenceMap s b
fmap a -> b
f (SequenceMap PlaceholderMap s (SequenceMap s a)
m Maybe a
v) = PlaceholderMap s (SequenceMap s b) -> Maybe b -> SequenceMap s b
forall s a.
PlaceholderMap s (SequenceMap s a) -> Maybe a -> SequenceMap s a
SequenceMap ((a -> b) -> SequenceMap s a -> SequenceMap s b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (SequenceMap s a -> SequenceMap s b)
-> PlaceholderMap s (SequenceMap s a)
-> PlaceholderMap s (SequenceMap s b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PlaceholderMap s (SequenceMap s a)
m) (a -> b
f (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe a
v)

leaf :: Maybe a -> SequenceMap s a
leaf :: Maybe a -> SequenceMap s a
leaf = PlaceholderMap s (SequenceMap s a) -> Maybe a -> SequenceMap s a
forall s a.
PlaceholderMap s (SequenceMap s a) -> Maybe a -> SequenceMap s a
SequenceMap PlaceholderMap s (SequenceMap s a)
forall s a. PlaceholderMap s a
emptyPlaceholderMap

instance RouteString s => Applicative (SequenceMap s) where
  pure :: a -> SequenceMap s a
pure = Maybe a -> SequenceMap s a
forall a s. Maybe a -> SequenceMap s a
leaf (Maybe a -> SequenceMap s a)
-> (a -> Maybe a) -> a -> SequenceMap s a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just
  SequenceMap PlaceholderMap s (SequenceMap s (a -> b))
fm Maybe (a -> b)
fv <*> :: SequenceMap s (a -> b) -> SequenceMap s a -> SequenceMap s b
<*> SequenceMap s a
a = (SequenceMap s b -> SequenceMap s b)
-> ((a -> b) -> SequenceMap s b -> SequenceMap s b)
-> Maybe (a -> b)
-> SequenceMap s b
-> SequenceMap s b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe SequenceMap s b -> SequenceMap s b
forall a. a -> a
id (\a -> b
f -> (a -> b
f (a -> b) -> SequenceMap s a -> SequenceMap s b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SequenceMap s a
a SequenceMap s b -> SequenceMap s b -> SequenceMap s b
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>)) Maybe (a -> b)
fv
    (SequenceMap s b -> SequenceMap s b)
-> SequenceMap s b -> SequenceMap s b
forall a b. (a -> b) -> a -> b
$ PlaceholderMap s (SequenceMap s b) -> Maybe b -> SequenceMap s b
forall s a.
PlaceholderMap s (SequenceMap s a) -> Maybe a -> SequenceMap s a
SequenceMap ((SequenceMap s (a -> b) -> SequenceMap s a -> SequenceMap s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SequenceMap s a
a) (SequenceMap s (a -> b) -> SequenceMap s b)
-> PlaceholderMap s (SequenceMap s (a -> b))
-> PlaceholderMap s (SequenceMap s b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PlaceholderMap s (SequenceMap s (a -> b))
fm) Maybe b
forall a. Maybe a
Nothing
  SequenceMap PlaceholderMap s (SequenceMap s a)
am Maybe a
Nothing *> :: SequenceMap s a -> SequenceMap s b -> SequenceMap s b
*> SequenceMap s b
b =
    PlaceholderMap s (SequenceMap s b) -> Maybe b -> SequenceMap s b
forall s a.
PlaceholderMap s (SequenceMap s a) -> Maybe a -> SequenceMap s a
SequenceMap ((SequenceMap s a -> SequenceMap s b -> SequenceMap s b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> SequenceMap s b
b) (SequenceMap s a -> SequenceMap s b)
-> PlaceholderMap s (SequenceMap s a)
-> PlaceholderMap s (SequenceMap s b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PlaceholderMap s (SequenceMap s a)
am) Maybe b
forall a. Maybe a
Nothing
  SequenceMap PlaceholderMap s (SequenceMap s a)
am (Just a
_) *> SequenceMap s b
b = SequenceMap s b
b SequenceMap s b -> SequenceMap s b -> SequenceMap s b
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
    PlaceholderMap s (SequenceMap s b) -> Maybe b -> SequenceMap s b
forall s a.
PlaceholderMap s (SequenceMap s a) -> Maybe a -> SequenceMap s a
SequenceMap ((SequenceMap s a -> SequenceMap s b -> SequenceMap s b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> SequenceMap s b
b) (SequenceMap s a -> SequenceMap s b)
-> PlaceholderMap s (SequenceMap s a)
-> PlaceholderMap s (SequenceMap s b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PlaceholderMap s (SequenceMap s a)
am) Maybe b
forall a. Maybe a
Nothing

instance RouteString s => Alternative (SequenceMap s) where
  empty :: SequenceMap s a
empty = Maybe a -> SequenceMap s a
forall a s. Maybe a -> SequenceMap s a
leaf Maybe a
forall a. Maybe a
Nothing
  <|> :: SequenceMap s a -> SequenceMap s a -> SequenceMap s a
(<|>) = (Maybe a -> Maybe a -> Maybe a)
-> SequenceMap s a -> SequenceMap s a -> SequenceMap s a
forall s a.
RouteString s =>
(Maybe a -> Maybe a -> Maybe a)
-> SequenceMap s a -> SequenceMap s a -> SequenceMap s a
unionSequenceWith Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)

instance RouteString s => Monad (SequenceMap s) where
  SequenceMap PlaceholderMap s (SequenceMap s a)
mm Maybe a
mv >>= :: SequenceMap s a -> (a -> SequenceMap s b) -> SequenceMap s b
>>= a -> SequenceMap s b
f = (SequenceMap s b -> SequenceMap s b)
-> (a -> SequenceMap s b -> SequenceMap s b)
-> Maybe a
-> SequenceMap s b
-> SequenceMap s b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe SequenceMap s b -> SequenceMap s b
forall a. a -> a
id (SequenceMap s b -> SequenceMap s b -> SequenceMap s b
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) (SequenceMap s b -> SequenceMap s b -> SequenceMap s b)
-> (a -> SequenceMap s b)
-> a
-> SequenceMap s b
-> SequenceMap s b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> SequenceMap s b
f) Maybe a
mv
    (SequenceMap s b -> SequenceMap s b)
-> SequenceMap s b -> SequenceMap s b
forall a b. (a -> b) -> a -> b
$ PlaceholderMap s (SequenceMap s b) -> Maybe b -> SequenceMap s b
forall s a.
PlaceholderMap s (SequenceMap s a) -> Maybe a -> SequenceMap s a
SequenceMap ((SequenceMap s a -> (a -> SequenceMap s b) -> SequenceMap s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> SequenceMap s b
f) (SequenceMap s a -> SequenceMap s b)
-> PlaceholderMap s (SequenceMap s a)
-> PlaceholderMap s (SequenceMap s b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PlaceholderMap s (SequenceMap s a)
mm) Maybe b
forall a. Maybe a
Nothing
  >> :: SequenceMap s a -> SequenceMap s b -> SequenceMap s b
(>>) = SequenceMap s a -> SequenceMap s b -> SequenceMap s b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>)

instance RouteString s => MonadPlus (SequenceMap s)

newtype SequenceMapP s a = SequenceMapP { SequenceMapP s a -> SequenceMap s (DynamicState a)
sequenceMapP :: SequenceMap s (DynamicState a) }

instance Functor (SequenceMapP s) where
  fmap :: (a -> b) -> SequenceMapP s a -> SequenceMapP s b
fmap a -> b
f (SequenceMapP SequenceMap s (DynamicState a)
m) = SequenceMap s (DynamicState b) -> SequenceMapP s b
forall s a. SequenceMap s (DynamicState a) -> SequenceMapP s a
SequenceMapP (SequenceMap s (DynamicState b) -> SequenceMapP s b)
-> SequenceMap s (DynamicState b) -> SequenceMapP s b
forall a b. (a -> b) -> a -> b
$ (DynamicState a -> DynamicState b)
-> SequenceMap s (DynamicState a) -> SequenceMap s (DynamicState b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> DynamicState a -> DynamicState b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) SequenceMap s (DynamicState a)
m

instance RouteString s => Applicative (SequenceMapP s) where
  pure :: a -> SequenceMapP s a
pure = SequenceMap s (DynamicState a) -> SequenceMapP s a
forall s a. SequenceMap s (DynamicState a) -> SequenceMapP s a
SequenceMapP (SequenceMap s (DynamicState a) -> SequenceMapP s a)
-> (a -> SequenceMap s (DynamicState a)) -> a -> SequenceMapP s a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynamicState a -> SequenceMap s (DynamicState a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DynamicState a -> SequenceMap s (DynamicState a))
-> (a -> DynamicState a) -> a -> SequenceMap s (DynamicState a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> DynamicState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  SequenceMapP SequenceMap s (DynamicState (a -> b))
f <*> :: SequenceMapP s (a -> b) -> SequenceMapP s a -> SequenceMapP s b
<*> SequenceMapP SequenceMap s (DynamicState a)
m = SequenceMap s (DynamicState b) -> SequenceMapP s b
forall s a. SequenceMap s (DynamicState a) -> SequenceMapP s a
SequenceMapP (SequenceMap s (DynamicState b) -> SequenceMapP s b)
-> SequenceMap s (DynamicState b) -> SequenceMapP s b
forall a b. (a -> b) -> a -> b
$ (DynamicState (a -> b) -> DynamicState a -> DynamicState b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>) (DynamicState (a -> b) -> DynamicState a -> DynamicState b)
-> SequenceMap s (DynamicState (a -> b))
-> SequenceMap s (DynamicState a -> DynamicState b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SequenceMap s (DynamicState (a -> b))
f) SequenceMap s (DynamicState a -> DynamicState b)
-> SequenceMap s (DynamicState a) -> SequenceMap s (DynamicState b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SequenceMap s (DynamicState a)
m
  SequenceMapP SequenceMap s (DynamicState a)
a  *> :: SequenceMapP s a -> SequenceMapP s b -> SequenceMapP s b
*> SequenceMapP SequenceMap s (DynamicState b)
b = SequenceMap s (DynamicState b) -> SequenceMapP s b
forall s a. SequenceMap s (DynamicState a) -> SequenceMapP s a
SequenceMapP (SequenceMap s (DynamicState b) -> SequenceMapP s b)
-> SequenceMap s (DynamicState b) -> SequenceMapP s b
forall a b. (a -> b) -> a -> b
$ ( DynamicState a
-> StateT Dynamics Identity Any -> StateT Dynamics Identity Any
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>) (DynamicState a
 -> StateT Dynamics Identity Any -> StateT Dynamics Identity Any)
-> SequenceMap s (DynamicState a)
-> SequenceMap
     s (StateT Dynamics Identity Any -> StateT Dynamics Identity Any)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SequenceMap s (DynamicState a)
a)  SequenceMap
  s (StateT Dynamics Identity Any -> StateT Dynamics Identity Any)
-> SequenceMap s (DynamicState b) -> SequenceMap s (DynamicState b)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> SequenceMap s (DynamicState b)
b

instance RouteString s => Alternative (SequenceMapP s) where
  empty :: SequenceMapP s a
empty = SequenceMap s (DynamicState a) -> SequenceMapP s a
forall s a. SequenceMap s (DynamicState a) -> SequenceMapP s a
SequenceMapP SequenceMap s (DynamicState a)
forall (f :: * -> *) a. Alternative f => f a
empty
  SequenceMapP SequenceMap s (DynamicState a)
a <|> :: SequenceMapP s a -> SequenceMapP s a -> SequenceMapP s a
<|> SequenceMapP SequenceMap s (DynamicState a)
b = SequenceMap s (DynamicState a) -> SequenceMapP s a
forall s a. SequenceMap s (DynamicState a) -> SequenceMapP s a
SequenceMapP (SequenceMap s (DynamicState a) -> SequenceMapP s a)
-> SequenceMap s (DynamicState a) -> SequenceMapP s a
forall a b. (a -> b) -> a -> b
$ SequenceMap s (DynamicState a)
a SequenceMap s (DynamicState a)
-> SequenceMap s (DynamicState a) -> SequenceMap s (DynamicState a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SequenceMap s (DynamicState a)
b

placeholderMap :: RouteString s => Placeholder s a -> SequenceMapP s a
placeholderMap :: Placeholder s a -> SequenceMapP s a
placeholderMap Placeholder s a
p = SequenceMap s (DynamicState a) -> SequenceMapP s a
forall s a. SequenceMap s (DynamicState a) -> SequenceMapP s a
SequenceMapP (SequenceMap s (DynamicState a) -> SequenceMapP s a)
-> SequenceMap s (DynamicState a) -> SequenceMapP s a
forall a b. (a -> b) -> a -> b
$
  PlaceholderMap s (SequenceMap s (DynamicState a))
-> Maybe (DynamicState a) -> SequenceMap s (DynamicState a)
forall s a.
PlaceholderMap s (SequenceMap s a) -> Maybe a -> SequenceMap s a
SequenceMap (DynamicState a -> SequenceMap s (DynamicState a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DynamicState a -> SequenceMap s (DynamicState a))
-> PlaceholderMap s (DynamicState a)
-> PlaceholderMap s (SequenceMap s (DynamicState a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Placeholder s a -> PlaceholderMap s (DynamicState a)
forall s a.
RouteString s =>
Placeholder s a -> PlaceholderMap s (DynamicState a)
singletonPlaceholderState Placeholder s a
p) Maybe (DynamicState a)
forall a. Maybe a
Nothing

singletonSequenceP :: RouteString s => Sequence s a -> SequenceMapP s a
singletonSequenceP :: Sequence s a -> SequenceMapP s a
singletonSequenceP = Free (SequenceMapP s) a -> SequenceMapP s a
forall (f :: * -> *) a. Alternative f => Free f a -> f a
runFree (Free (SequenceMapP s) a -> SequenceMapP s a)
-> (Sequence s a -> Free (SequenceMapP s) a)
-> Sequence s a
-> SequenceMapP s a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a'. Placeholder s a' -> SequenceMapP s a')
-> Free (Placeholder s) a -> Free (SequenceMapP s) a
forall (f :: * -> *) (m :: * -> *) a.
(forall a'. f a' -> m a') -> Free f a -> Free m a
mapFree forall a'. Placeholder s a' -> SequenceMapP s a'
forall s a. RouteString s => Placeholder s a -> SequenceMapP s a
placeholderMap (Free (Placeholder s) a -> Free (SequenceMapP s) a)
-> (Sequence s a -> Free (Placeholder s) a)
-> Sequence s a
-> Free (SequenceMapP s) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sequence s a -> Free (Placeholder s) a
forall s a. Sequence s a -> Free (Placeholder s) a
freeSequence

-- |A sequence representing a single 'Sequence', with underlying @s@ strings as keys mapping to functions that convert from the resulting parsed parameters to the associated 'Sequence' value.
-- Note that a single 'Sequence' can create multiple elements in the map, so this is not strictly a /singleton/.
singletonSequence :: RouteString s => Sequence s a -> SequenceMap s (DynamicState a)
singletonSequence :: Sequence s a -> SequenceMap s (DynamicState a)
singletonSequence = SequenceMapP s a -> SequenceMap s (DynamicState a)
forall s a. SequenceMapP s a -> SequenceMap s (DynamicState a)
sequenceMapP (SequenceMapP s a -> SequenceMap s (DynamicState a))
-> (Sequence s a -> SequenceMapP s a)
-> Sequence s a
-> SequenceMap s (DynamicState a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sequence s a -> SequenceMapP s a
forall s a. RouteString s => Sequence s a -> SequenceMapP s a
singletonSequenceP

-- |Lookup a list of strings in a 'SequenceMap', returning all the associated values as tuples of the parsed dynamic placeholders and the associated value.
-- Note that if this map was created by 'singletonSequence', those values are themselves functions, so applying the first element to the second result will produce the original sequence value.
-- This is the equivalent of 'parseSequence':
--
-- > parseSequence q s === map (uncurry ($)) (lookupSequence s (singletonSequence q))
--
-- Except that 'lookupSequence' is far more efficient, especially when there are large number of alternatives.
lookupSequence :: RouteString s => [s] -> SequenceMap s a -> [DynamicResult a]
lookupSequence :: [s] -> SequenceMap s a -> [DynamicResult a]
lookupSequence (s
s:[s]
l) (SequenceMap PlaceholderMap s (SequenceMap s a)
m Maybe a
_) = s
-> PlaceholderMap s (SequenceMap s a)
-> (SequenceMap s a -> [DynamicResult a])
-> [DynamicResult a]
forall s a b.
RouteString s =>
s
-> PlaceholderMap s a
-> (a -> [DynamicResult b])
-> [DynamicResult b]
lookupPlaceholderWith s
s PlaceholderMap s (SequenceMap s a)
m ((SequenceMap s a -> [DynamicResult a]) -> [DynamicResult a])
-> (SequenceMap s a -> [DynamicResult a]) -> [DynamicResult a]
forall a b. (a -> b) -> a -> b
$ [s] -> SequenceMap s a -> [DynamicResult a]
forall s a.
RouteString s =>
[s] -> SequenceMap s a -> [DynamicResult a]
lookupSequence [s]
l
lookupSequence [] (SequenceMap PlaceholderMap s (SequenceMap s a)
_ Maybe a
Nothing) = [DynamicResult a]
forall (m :: * -> *) a. MonadPlus m => m a
mzero
lookupSequence [] (SequenceMap PlaceholderMap s (SequenceMap s a)
_ (Just a
x)) = DynamicResult a -> [DynamicResult a]
forall (m :: * -> *) a. Monad m => a -> m a
return ([], a
x)

-- |An example way to use 'SequenceMap' to abstract over and thus union multiple heterogeneous sequences.
type SequenceMapApp s m a = SequenceMap s (m (Dynamics -> a))

-- |Create a map from a single 'Sequence' parser.  Since this abstracts the type of the sequence @p@ (but not @a@), sequences with different underlying types can be combined in the same map.
singletonSequenceApp :: (RouteString s, Functor m) => Sequence s a -> m (a -> b) -> SequenceMapApp s m b
singletonSequenceApp :: Sequence s a -> m (a -> b) -> SequenceMapApp s m b
singletonSequenceApp Sequence s a
p m (a -> b)
m = (\State Dynamics a
f -> ((a -> b) -> Dynamics -> b) -> m (a -> b) -> m (Dynamics -> b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> (Dynamics -> a) -> Dynamics -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State Dynamics a -> Dynamics -> a
forall s a. State s a -> s -> a
evalState State Dynamics a
f) m (a -> b)
m) (State Dynamics a -> m (Dynamics -> b))
-> SequenceMap s (State Dynamics a) -> SequenceMapApp s m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sequence s a -> SequenceMap s (State Dynamics a)
forall s a.
RouteString s =>
Sequence s a -> SequenceMap s (DynamicState a)
singletonSequence Sequence s a
p

-- |Lookup a sequence in the map and return the value, combining ambiguous sequences using the 'Monoid' instance on their values.
-- Generally /O(log n)/ in the total number of sequences, except /O(n)/ in the length of the sequence and the number of different (ambiguous) 'SequenceParameter' types at each level (from 'PM.lookup').
-- However, it also incurs the cost of an 'fmap' on @m@, which it may be better to defer pending later lookups.
lookupSequenceApp :: (RouteString s, Functor m, Monoid (m a)) => [s] -> SequenceMapApp s m a -> m a
lookupSequenceApp :: [s] -> SequenceMapApp s m a -> m a
lookupSequenceApp [s]
l = ((Dynamics, m (Dynamics -> a)) -> m a)
-> [(Dynamics, m (Dynamics -> a))] -> m a
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\(Dynamics
x, m (Dynamics -> a)
f) -> ((Dynamics -> a) -> a) -> m (Dynamics -> a) -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Dynamics -> a) -> Dynamics -> a
forall a b. (a -> b) -> a -> b
$ Dynamics
x) m (Dynamics -> a)
f) ([(Dynamics, m (Dynamics -> a))] -> m a)
-> (SequenceMapApp s m a -> [(Dynamics, m (Dynamics -> a))])
-> SequenceMapApp s m a
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [s] -> SequenceMapApp s m a -> [(Dynamics, m (Dynamics -> a))]
forall s a.
RouteString s =>
[s] -> SequenceMap s a -> [DynamicResult a]
lookupSequence [s]
l