{-# LANGUAGE FlexibleContexts #-}
module Web.Route.Invertible.Map.Default
( DefaultMap(..)
, defaultingMap
, defaultingValue
, withDefaultMap
, lookupDefault
) where
import Control.Applicative ((<|>))
data DefaultMap m v = DefaultMap
{ DefaultMap m v -> m v
defaultMap :: !(m v)
, DefaultMap m v -> Maybe v
defaultValue :: !(Maybe v)
} deriving (DefaultMap m v -> DefaultMap m v -> Bool
(DefaultMap m v -> DefaultMap m v -> Bool)
-> (DefaultMap m v -> DefaultMap m v -> Bool)
-> Eq (DefaultMap m v)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (m :: * -> *) v.
(Eq v, Eq (m v)) =>
DefaultMap m v -> DefaultMap m v -> Bool
/= :: DefaultMap m v -> DefaultMap m v -> Bool
$c/= :: forall (m :: * -> *) v.
(Eq v, Eq (m v)) =>
DefaultMap m v -> DefaultMap m v -> Bool
== :: DefaultMap m v -> DefaultMap m v -> Bool
$c== :: forall (m :: * -> *) v.
(Eq v, Eq (m v)) =>
DefaultMap m v -> DefaultMap m v -> Bool
Eq, Int -> DefaultMap m v -> ShowS
[DefaultMap m v] -> ShowS
DefaultMap m v -> String
(Int -> DefaultMap m v -> ShowS)
-> (DefaultMap m v -> String)
-> ([DefaultMap m v] -> ShowS)
-> Show (DefaultMap m v)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (m :: * -> *) v.
(Show v, Show (m v)) =>
Int -> DefaultMap m v -> ShowS
forall (m :: * -> *) v.
(Show v, Show (m v)) =>
[DefaultMap m v] -> ShowS
forall (m :: * -> *) v.
(Show v, Show (m v)) =>
DefaultMap m v -> String
showList :: [DefaultMap m v] -> ShowS
$cshowList :: forall (m :: * -> *) v.
(Show v, Show (m v)) =>
[DefaultMap m v] -> ShowS
show :: DefaultMap m v -> String
$cshow :: forall (m :: * -> *) v.
(Show v, Show (m v)) =>
DefaultMap m v -> String
showsPrec :: Int -> DefaultMap m v -> ShowS
$cshowsPrec :: forall (m :: * -> *) v.
(Show v, Show (m v)) =>
Int -> DefaultMap m v -> ShowS
Show)
instance Functor m => Functor (DefaultMap m) where
fmap :: (a -> b) -> DefaultMap m a -> DefaultMap m b
fmap a -> b
f (DefaultMap m a
m Maybe a
d) = m b -> Maybe b -> DefaultMap m b
forall (m :: * -> *) v. m v -> Maybe v -> DefaultMap m v
DefaultMap ((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) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Maybe a
d)
instance (Semigroup v, Semigroup (m v)) => Semigroup (DefaultMap m v) where
DefaultMap m v
m1 Maybe v
d1 <> :: DefaultMap m v -> DefaultMap m v -> DefaultMap m v
<> DefaultMap m v
m2 Maybe v
d2 = m v -> Maybe v -> DefaultMap m v
forall (m :: * -> *) v. m v -> Maybe v -> DefaultMap m v
DefaultMap (m v
m1 m v -> m v -> m v
forall a. Semigroup a => a -> a -> a
<> m v
m2) (Maybe v
d1 Maybe v -> Maybe v -> Maybe v
forall a. Semigroup a => a -> a -> a
<> Maybe v
d2)
instance (Monoid v, Monoid (m v)) => Monoid (DefaultMap m v) where
mempty :: DefaultMap m v
mempty = m v -> Maybe v -> DefaultMap m v
forall (m :: * -> *) v. m v -> Maybe v -> DefaultMap m v
DefaultMap m v
forall a. Monoid a => a
mempty Maybe v
forall a. Maybe a
Nothing
mappend :: DefaultMap m v -> DefaultMap m v -> DefaultMap m v
mappend (DefaultMap m v
m1 Maybe v
d1) (DefaultMap m v
m2 Maybe v
d2) = m v -> Maybe v -> DefaultMap m v
forall (m :: * -> *) v. m v -> Maybe v -> DefaultMap m v
DefaultMap (m v -> m v -> m v
forall a. Monoid a => a -> a -> a
mappend m v
m1 m v
m2) (Maybe v -> Maybe v -> Maybe v
forall a. Monoid a => a -> a -> a
mappend Maybe v
d1 Maybe v
d2)
defaultingMap :: m v -> DefaultMap m v
defaultingMap :: m v -> DefaultMap m v
defaultingMap m v
m = m v -> Maybe v -> DefaultMap m v
forall (m :: * -> *) v. m v -> Maybe v -> DefaultMap m v
DefaultMap m v
m Maybe v
forall a. Maybe a
Nothing
defaultingValue :: Monoid (m v) => v -> DefaultMap m v
defaultingValue :: v -> DefaultMap m v
defaultingValue = m v -> Maybe v -> DefaultMap m v
forall (m :: * -> *) v. m v -> Maybe v -> DefaultMap m v
DefaultMap m v
forall a. Monoid a => a
mempty (Maybe v -> DefaultMap m v)
-> (v -> Maybe v) -> v -> DefaultMap m v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Maybe v
forall a. a -> Maybe a
Just
withDefaultMap :: (m v -> n v) -> DefaultMap m v -> DefaultMap n v
withDefaultMap :: (m v -> n v) -> DefaultMap m v -> DefaultMap n v
withDefaultMap m v -> n v
f (DefaultMap m v
m Maybe v
v) = n v -> Maybe v -> DefaultMap n v
forall (m :: * -> *) v. m v -> Maybe v -> DefaultMap m v
DefaultMap (m v -> n v
f m v
m) Maybe v
v
lookupDefault :: (m v -> Maybe v) -> DefaultMap m v -> Maybe v
lookupDefault :: (m v -> Maybe v) -> DefaultMap m v -> Maybe v
lookupDefault m v -> Maybe v
l (DefaultMap m v
m Maybe v
d) = m v -> Maybe v
l m v
m Maybe v -> Maybe v -> Maybe v
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe v
d