{-# LANGUAGE FlexibleContexts #-}
module Web.Route.Invertible.Map.Const
( ConstMap(..)
, withConstMap
, constantMap
, constantValue
, lookupConst
, flattenConstMap
, ConstDefaultMap
, flattenConstDefaultMap
) where
import Web.Route.Invertible.Map.Default
data ConstMap m v = ConstMap
{ ConstMap m v -> m v
constMap :: !(m v)
, ConstMap m v -> v
constValue :: !v }
deriving (Int -> ConstMap m v -> ShowS
[ConstMap m v] -> ShowS
ConstMap m v -> String
(Int -> ConstMap m v -> ShowS)
-> (ConstMap m v -> String)
-> ([ConstMap m v] -> ShowS)
-> Show (ConstMap m v)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (m :: * -> *) v.
(Show v, Show (m v)) =>
Int -> ConstMap m v -> ShowS
forall (m :: * -> *) v.
(Show v, Show (m v)) =>
[ConstMap m v] -> ShowS
forall (m :: * -> *) v.
(Show v, Show (m v)) =>
ConstMap m v -> String
showList :: [ConstMap m v] -> ShowS
$cshowList :: forall (m :: * -> *) v.
(Show v, Show (m v)) =>
[ConstMap m v] -> ShowS
show :: ConstMap m v -> String
$cshow :: forall (m :: * -> *) v.
(Show v, Show (m v)) =>
ConstMap m v -> String
showsPrec :: Int -> ConstMap m v -> ShowS
$cshowsPrec :: forall (m :: * -> *) v.
(Show v, Show (m v)) =>
Int -> ConstMap m v -> ShowS
Show)
instance Functor m => Functor (ConstMap m) where
fmap :: (a -> b) -> ConstMap m a -> ConstMap m b
fmap a -> b
f (ConstMap m a
m a
v) = m b -> b -> ConstMap m b
forall (m :: * -> *) v. m v -> v -> ConstMap m v
ConstMap ((a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f m a
m) (a -> b
f a
v)
instance (Semigroup v, Semigroup (m v)) => Semigroup (ConstMap m v) where
ConstMap m v
m1 v
v1 <> :: ConstMap m v -> ConstMap m v -> ConstMap m v
<> ConstMap m v
m2 v
v2 = m v -> v -> ConstMap m v
forall (m :: * -> *) v. m v -> v -> ConstMap m v
ConstMap (m v
m1 m v -> m v -> m v
forall a. Semigroup a => a -> a -> a
<> m v
m2) (v
v1 v -> v -> v
forall a. Semigroup a => a -> a -> a
<> v
v2)
instance (Monoid v, Monoid (m v)) => Monoid (ConstMap m v) where
mempty :: ConstMap m v
mempty = m v -> v -> ConstMap m v
forall (m :: * -> *) v. m v -> v -> ConstMap m v
ConstMap m v
forall a. Monoid a => a
mempty v
forall a. Monoid a => a
mempty
mappend :: ConstMap m v -> ConstMap m v -> ConstMap m v
mappend (ConstMap m v
m1 v
v1) (ConstMap m v
m2 v
v2) = m v -> v -> ConstMap m v
forall (m :: * -> *) v. m v -> v -> ConstMap m v
ConstMap (m v -> m v -> m v
forall a. Monoid a => a -> a -> a
mappend m v
m1 m v
m2) (v -> v -> v
forall a. Monoid a => a -> a -> a
mappend v
v1 v
v2)
withConstMap :: (m v -> n v) -> ConstMap m v -> ConstMap n v
withConstMap :: (m v -> n v) -> ConstMap m v -> ConstMap n v
withConstMap m v -> n v
f (ConstMap m v
m v
v) = n v -> v -> ConstMap n v
forall (m :: * -> *) v. m v -> v -> ConstMap m v
ConstMap (m v -> n v
f m v
m) v
v
constantMap :: Monoid v => m v -> ConstMap m v
constantMap :: m v -> ConstMap m v
constantMap m v
m = m v -> v -> ConstMap m v
forall (m :: * -> *) v. m v -> v -> ConstMap m v
ConstMap m v
m v
forall a. Monoid a => a
mempty
constantValue :: Monoid (m v) => v -> ConstMap m v
constantValue :: v -> ConstMap m v
constantValue = m v -> v -> ConstMap m v
forall (m :: * -> *) v. m v -> v -> ConstMap m v
ConstMap m v
forall a. Monoid a => a
mempty
lookupConst :: Semigroup v => (m v -> v) -> ConstMap m v -> v
lookupConst :: (m v -> v) -> ConstMap m v -> v
lookupConst m v -> v
l (ConstMap m v
m v
v) = m v -> v
l m v
m v -> v -> v
forall a. Semigroup a => a -> a -> a
<> v
v
flattenConstMap :: (Functor m, Semigroup v) => ConstMap m v -> DefaultMap m v
flattenConstMap :: ConstMap m v -> DefaultMap m v
flattenConstMap (ConstMap m v
m v
v) = m v -> Maybe v -> DefaultMap m v
forall (m :: * -> *) v. m v -> Maybe v -> DefaultMap m v
DefaultMap ((v -> v) -> m v -> m v
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (v -> v -> v
forall a. Semigroup a => a -> a -> a
<> v
v) m v
m) (v -> Maybe v
forall a. a -> Maybe a
Just v
v)
type ConstDefaultMap m = ConstMap (DefaultMap m)
flattenConstDefaultMap :: (Functor m, Semigroup v) => ConstDefaultMap m v -> DefaultMap m v
flattenConstDefaultMap :: ConstDefaultMap m v -> DefaultMap m v
flattenConstDefaultMap (ConstMap (DefaultMap m v
m Maybe v
d) v
v) = m v -> Maybe v -> DefaultMap m v
forall (m :: * -> *) v. m v -> Maybe v -> DefaultMap m v
DefaultMap ((v -> v) -> m v -> m v
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (v -> v -> v
forall a. Semigroup a => a -> a -> a
<> v
v) m v
m) (Maybe v
d Maybe v -> Maybe v -> Maybe v
forall a. Semigroup a => a -> a -> a
<> v -> Maybe v
forall a. a -> Maybe a
Just v
v)