{-# LANGUAGE GeneralizedNewtypeDeriving, MultiParamTypeClasses, FlexibleInstances, ScopedTypeVariables, GADTs #-}
module Web.Route.Invertible.Sequence
( Sequence(..)
, placeholderSequence
, wildcard
, sequenceValues
, renderSequence
, readsSequence
, parseSequence
, reverseSequence
) where
import Control.Invertible.Monoidal
import Control.Invertible.Monoidal.Free
import Control.Monad (MonadPlus, mzero, guard)
import Control.Monad.Fail (MonadFail)
import qualified Data.Invertible as I
import Data.String (IsString(..))
import Web.Route.Invertible.Parameter
import Web.Route.Invertible.Placeholder
newtype Sequence s a = Sequence { Sequence s a -> Free (Placeholder s) a
freeSequence :: Free (Placeholder s) a }
deriving ((a <-> b) -> Sequence s a -> Sequence s b
(forall a b. (a <-> b) -> Sequence s a -> Sequence s b)
-> Functor (Sequence s)
forall a b. (a <-> b) -> Sequence s a -> Sequence s b
forall s a b. (a <-> b) -> Sequence s a -> Sequence s b
forall (f :: * -> *).
(forall a b. (a <-> b) -> f a -> f b) -> Functor f
fmap :: (a <-> b) -> Sequence s a -> Sequence s b
$cfmap :: forall s a b. (a <-> b) -> Sequence s a -> Sequence s b
I.Functor, Functor (Sequence s)
Sequence s ()
Functor (Sequence s)
-> Sequence s ()
-> (forall a b. Sequence s a -> Sequence s b -> Sequence s (a, b))
-> Monoidal (Sequence s)
Sequence s a -> Sequence s b -> Sequence s (a, b)
forall s. Functor (Sequence s)
forall s. Sequence s ()
forall a b. Sequence s a -> Sequence s b -> Sequence s (a, b)
forall s a b. Sequence s a -> Sequence s b -> Sequence s (a, b)
forall (f :: * -> *).
Functor f
-> f () -> (forall a b. f a -> f b -> f (a, b)) -> Monoidal f
>*< :: Sequence s a -> Sequence s b -> Sequence s (a, b)
$c>*< :: forall s a b. Sequence s a -> Sequence s b -> Sequence s (a, b)
unit :: Sequence s ()
$cunit :: forall s. Sequence s ()
$cp1Monoidal :: forall s. Functor (Sequence s)
Monoidal, Monoidal (Sequence s)
Sequence s Void
Monoidal (Sequence s)
-> Sequence s Void
-> (forall a b.
Sequence s a -> Sequence s b -> Sequence s (Either a b))
-> MonoidalAlt (Sequence s)
Sequence s a -> Sequence s b -> Sequence s (Either a b)
forall s. Monoidal (Sequence s)
forall s. Sequence s Void
forall a b. Sequence s a -> Sequence s b -> Sequence s (Either a b)
forall s a b.
Sequence s a -> Sequence s b -> Sequence s (Either a b)
forall (f :: * -> *).
Monoidal f
-> f Void
-> (forall a b. f a -> f b -> f (Either a b))
-> MonoidalAlt f
>|< :: Sequence s a -> Sequence s b -> Sequence s (Either a b)
$c>|< :: forall s a b.
Sequence s a -> Sequence s b -> Sequence s (Either a b)
zero :: Sequence s Void
$czero :: forall s. Sequence s Void
$cp1MonoidalAlt :: forall s. Monoidal (Sequence s)
MonoidalAlt)
instance Show s => Show (Sequence s a) where
showsPrec :: Int -> Sequence s a -> ShowS
showsPrec Int
d (Sequence Free (Placeholder s) a
s) = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
String -> ShowS
showString String
"Sequence " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a'. Placeholder s a' -> ShowS)
-> Free (Placeholder s) a -> ShowS
forall (f :: * -> *) a.
(forall a'. f a' -> ShowS) -> Free f a -> ShowS
showsFree (Int -> Placeholder s a' -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11) Free (Placeholder s) a
s
placeholderSequence :: Placeholder s a -> Sequence s a
placeholderSequence :: Placeholder s a -> Sequence s a
placeholderSequence = Free (Placeholder s) a -> Sequence s a
forall s a. Free (Placeholder s) a -> Sequence s a
Sequence (Free (Placeholder s) a -> Sequence s a)
-> (Placeholder s a -> Free (Placeholder s) a)
-> Placeholder s a
-> Sequence s a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Placeholder s a -> Free (Placeholder s) a
forall (f :: * -> *) a. f a -> Free f a
Free
instance Parameterized s (Sequence s) where
parameter :: Sequence s a
parameter = Placeholder s a -> Sequence s a
forall s a. Placeholder s a -> Sequence s a
placeholderSequence Placeholder s a
forall s (p :: * -> *) a. (Parameterized s p, Parameter s a) => p a
parameter
instance IsString s => IsString (Sequence s ()) where
fromString :: String -> Sequence s ()
fromString = Placeholder s () -> Sequence s ()
forall s a. Placeholder s a -> Sequence s a
placeholderSequence (Placeholder s () -> Sequence s ())
-> (String -> Placeholder s ()) -> String -> Sequence s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Placeholder s ()
forall a. IsString a => String -> a
fromString
wildcard :: (Parameterized s f, MonoidalAlt f, Parameter s a) => [a] -> f ()
wildcard :: [a] -> f ()
wildcard [a]
d = [a]
d [a] -> f [a] -> f ()
forall (f :: * -> *) a. Functor f => a -> f a -> f ()
>$ f a -> f [a]
forall (f :: * -> *) a. MonoidalAlt f => f a -> f [a]
manyI f a
forall s (p :: * -> *) a. (Parameterized s p, Parameter s a) => p a
parameter
sequenceValues :: Sequence s a -> a -> [PlaceholderValue s]
sequenceValues :: Sequence s a -> a -> [PlaceholderValue s]
sequenceValues = (forall a'. Placeholder s a' -> a' -> PlaceholderValue s)
-> Free (Placeholder s) a -> a -> [PlaceholderValue s]
forall (m :: * -> *) (f :: * -> *) b a.
Alternative m =>
(forall a'. f a' -> a' -> b) -> Free f a -> a -> m b
produceFree forall a'. Placeholder s a' -> a' -> PlaceholderValue s
forall s a'. Placeholder s a' -> a' -> PlaceholderValue s
f (Free (Placeholder s) a -> a -> [PlaceholderValue s])
-> (Sequence s a -> Free (Placeholder s) a)
-> Sequence s a
-> a
-> [PlaceholderValue s]
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 where
f :: Placeholder s a' -> a' -> PlaceholderValue s
f :: Placeholder s a' -> a' -> PlaceholderValue s
f (PlaceholderFixed s
t) () = s -> PlaceholderValue s
forall s. s -> PlaceholderValue s
PlaceholderValueFixed s
t
f Placeholder s a'
PlaceholderParameter a'
a = a' -> PlaceholderValue s
forall s a. Parameter s a => a -> PlaceholderValue s
PlaceholderValueParameter a'
a
renderSequence :: Sequence s a -> a -> [s]
renderSequence :: Sequence s a -> a -> [s]
renderSequence Sequence s a
p = (PlaceholderValue s -> s) -> [PlaceholderValue s] -> [s]
forall a b. (a -> b) -> [a] -> [b]
map PlaceholderValue s -> s
forall s. PlaceholderValue s -> s
renderPlaceholderValue ([PlaceholderValue s] -> [s])
-> (a -> [PlaceholderValue s]) -> a -> [s]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sequence s a -> a -> [PlaceholderValue s]
forall s a. Sequence s a -> a -> [PlaceholderValue s]
sequenceValues Sequence s a
p
readsSequence :: forall m s a . (MonadPlus m, Eq s) => Sequence s a -> [s] -> m (a, [s])
readsSequence :: Sequence s a -> [s] -> m (a, [s])
readsSequence = (forall a'. Placeholder s a' -> s -> m a')
-> Free (Placeholder s) a -> [s] -> m (a, [s])
forall (m :: * -> *) (f :: * -> *) b a.
MonadPlus m =>
(forall a'. f a' -> b -> m a') -> Free f a -> [b] -> m (a, [b])
parseFree forall a'. Placeholder s a' -> s -> m a'
f (Free (Placeholder s) a -> [s] -> m (a, [s]))
-> (Sequence s a -> Free (Placeholder s) a)
-> Sequence s a
-> [s]
-> m (a, [s])
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 where
f :: Placeholder s a' -> s -> m a'
f :: Placeholder s a' -> s -> m a'
f (PlaceholderFixed s
t) s
a = Bool -> m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (s
a s -> s -> Bool
forall a. Eq a => a -> a -> Bool
== s
t)
f Placeholder s a'
PlaceholderParameter s
a = m a' -> (a' -> m a') -> Maybe a' -> m a'
forall b a. b -> (a -> b) -> Maybe a -> b
maybe m a'
forall (m :: * -> *) a. MonadPlus m => m a
mzero a' -> m a'
forall (m :: * -> *) a. Monad m => a -> m a
return (s -> Maybe a'
forall s a. Parameter s a => s -> Maybe a
parseParameter s
a)
parseSequence :: (MonadPlus m, MonadFail m, Eq s) => Sequence s a -> [s] -> m a
parseSequence :: Sequence s a -> [s] -> m a
parseSequence Sequence s a
p [s]
l = do
(a
a, []) <- Sequence s a -> [s] -> m (a, [s])
forall (m :: * -> *) s a.
(MonadPlus m, Eq s) =>
Sequence s a -> [s] -> m (a, [s])
readsSequence Sequence s a
p [s]
l
a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
reverseSequence :: Sequence s a -> Sequence s a
reverseSequence :: Sequence s a -> Sequence s a
reverseSequence = Free (Placeholder s) a -> Sequence s a
forall s a. Free (Placeholder s) a -> Sequence s a
Sequence (Free (Placeholder s) a -> Sequence s a)
-> (Sequence s a -> Free (Placeholder s) a)
-> Sequence s a
-> Sequence s a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Free (Placeholder s) a -> Free (Placeholder s) a
forall (f :: * -> *) a. Free f a -> Free f a
reverseFree (Free (Placeholder s) a -> Free (Placeholder s) a)
-> (Sequence s a -> Free (Placeholder s) a)
-> Sequence s a
-> Free (Placeholder 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