-- |Trivial map from boolean-valued keys to values, which just stores both possible values.
{-# LANGUAGE FlexibleContexts #-}
module Web.Route.Invertible.Map.Bool
  ( BoolMap(..)
  , emptyBoolMap
  , singletonBool
  , lookupBool
  ) where

import Data.Semigroup (Semigroup((<>)))

-- |A trivial, flat representation of a 'Bool'-keyed map.
-- Value existance (but not the values themselves) is strict.
data BoolMap v = BoolMap
  { BoolMap v -> Maybe v
boolMapFalse :: !(Maybe v) -- ^The value associated with 'False'.
  , BoolMap v -> Maybe v
boolMapTrue :: !(Maybe v) -- ^The value associated with 'True'.
  } deriving (BoolMap v -> BoolMap v -> Bool
(BoolMap v -> BoolMap v -> Bool)
-> (BoolMap v -> BoolMap v -> Bool) -> Eq (BoolMap v)
forall v. Eq v => BoolMap v -> BoolMap v -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BoolMap v -> BoolMap v -> Bool
$c/= :: forall v. Eq v => BoolMap v -> BoolMap v -> Bool
== :: BoolMap v -> BoolMap v -> Bool
$c== :: forall v. Eq v => BoolMap v -> BoolMap v -> Bool
Eq, Int -> BoolMap v -> ShowS
[BoolMap v] -> ShowS
BoolMap v -> String
(Int -> BoolMap v -> ShowS)
-> (BoolMap v -> String)
-> ([BoolMap v] -> ShowS)
-> Show (BoolMap v)
forall v. Show v => Int -> BoolMap v -> ShowS
forall v. Show v => [BoolMap v] -> ShowS
forall v. Show v => BoolMap v -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BoolMap v] -> ShowS
$cshowList :: forall v. Show v => [BoolMap v] -> ShowS
show :: BoolMap v -> String
$cshow :: forall v. Show v => BoolMap v -> String
showsPrec :: Int -> BoolMap v -> ShowS
$cshowsPrec :: forall v. Show v => Int -> BoolMap v -> ShowS
Show)

instance Functor BoolMap where
  fmap :: (a -> b) -> BoolMap a -> BoolMap b
fmap a -> b
f (BoolMap Maybe a
a Maybe a
b) = Maybe b -> Maybe b -> BoolMap b
forall v. Maybe v -> Maybe v -> BoolMap v
BoolMap ((a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Maybe a
a) ((a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Maybe a
b)

instance (Semigroup v) => Semigroup (BoolMap v) where
  BoolMap Maybe v
a1 Maybe v
b1 <> :: BoolMap v -> BoolMap v -> BoolMap v
<> BoolMap Maybe v
a2 Maybe v
b2 = Maybe v -> Maybe v -> BoolMap v
forall v. Maybe v -> Maybe v -> BoolMap v
BoolMap (Maybe v
a1 Maybe v -> Maybe v -> Maybe v
forall a. Semigroup a => a -> a -> a
<> Maybe v
a2) (Maybe v
b1 Maybe v -> Maybe v -> Maybe v
forall a. Semigroup a => a -> a -> a
<> Maybe v
b2)

instance (Monoid v) => Monoid (BoolMap v) where
  mempty :: BoolMap v
mempty = BoolMap v
forall a. BoolMap a
emptyBoolMap
  mappend :: BoolMap v -> BoolMap v -> BoolMap v
mappend (BoolMap Maybe v
a1 Maybe v
b1) (BoolMap Maybe v
a2 Maybe v
b2) = Maybe v -> Maybe v -> BoolMap v
forall v. Maybe v -> Maybe v -> BoolMap v
BoolMap (Maybe v -> Maybe v -> Maybe v
forall a. Monoid a => a -> a -> a
mappend Maybe v
a1 Maybe v
a2) (Maybe v -> Maybe v -> Maybe v
forall a. Monoid a => a -> a -> a
mappend Maybe v
b1 Maybe v
b2)

-- |The empty map.
emptyBoolMap :: BoolMap a
emptyBoolMap :: BoolMap a
emptyBoolMap = Maybe a -> Maybe a -> BoolMap a
forall v. Maybe v -> Maybe v -> BoolMap v
BoolMap Maybe a
forall a. Maybe a
Nothing Maybe a
forall a. Maybe a
Nothing

-- |A map with a single element, or if the key is @Nothing@, with both elements with same value.
singletonBool :: Maybe Bool -> a -> BoolMap a
singletonBool :: Maybe Bool -> a -> BoolMap a
singletonBool Maybe Bool
Nothing a
a = Maybe a -> Maybe a -> BoolMap a
forall v. Maybe v -> Maybe v -> BoolMap v
BoolMap (a -> Maybe a
forall a. a -> Maybe a
Just a
a) (a -> Maybe a
forall a. a -> Maybe a
Just a
a)
singletonBool (Just Bool
False) a
a = Maybe a -> Maybe a -> BoolMap a
forall v. Maybe v -> Maybe v -> BoolMap v
BoolMap (a -> Maybe a
forall a. a -> Maybe a
Just a
a) Maybe a
forall a. Maybe a
Nothing
singletonBool (Just Bool
True) a
a = Maybe a -> Maybe a -> BoolMap a
forall v. Maybe v -> Maybe v -> BoolMap v
BoolMap Maybe a
forall a. Maybe a
Nothing (a -> Maybe a
forall a. a -> Maybe a
Just a
a)

-- |Lookup the value at a key in the map.
lookupBool :: Bool -> BoolMap a -> Maybe a
lookupBool :: Bool -> BoolMap a -> Maybe a
lookupBool Bool
False (BoolMap Maybe a
a Maybe a
_) = Maybe a
a
lookupBool Bool
True (BoolMap Maybe a
_ Maybe a
a) = Maybe a
a