-- |
module Web.Route.Invertible.Map
  ( lookupParameter
  , reduce
  , lookupExactly
  , fallback
  ) where

import Prelude hiding (lookup)

import Control.Monad ((<=<))
import qualified Data.Map.Strict as M

import Web.Route.Invertible.Monoid.Exactly
import Web.Route.Invertible.Parameter

-- |Combine 'parseParameter' and 'M.lookup'.
lookupParameter :: (Ord p, Parameter s p) => s -> M.Map p a -> Maybe a
lookupParameter :: s -> Map p a -> Maybe a
lookupParameter s
s Map p a
m = s -> Maybe p
forall s a. Parameter s a => s -> Maybe a
parseParameter s
s Maybe p -> (p -> Maybe a) -> Maybe a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (p -> Map p a -> Maybe a
forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Map p a
m)

-- |Eliminate 'Blank' values, and (strictly) produce an error for 'Conflict' values.
reduce :: M.Map k (Exactly a) -> M.Map k a
reduce :: Map k (Exactly a) -> Map k a
reduce = (Exactly a -> Maybe a) -> Map k (Exactly a) -> Map k a
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
M.mapMaybe Exactly a -> Maybe a
forall a. Exactly a -> Maybe a
exactlyToMaybe

-- |Combine 'exactlyToMaybe' and 'M.lookup'.
lookupExactly :: Ord k => k -> M.Map k (Exactly a) -> Maybe a
lookupExactly :: k -> Map k (Exactly a) -> Maybe a
lookupExactly k
k = Exactly a -> Maybe a
forall a. Exactly a -> Maybe a
exactlyToMaybe (Exactly a -> Maybe a)
-> (Map k (Exactly a) -> Maybe (Exactly a))
-> Map k (Exactly a)
-> Maybe a
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< k -> Map k (Exactly a) -> Maybe (Exactly a)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup k
k

-- |When the first key is not in the map, produce a new map that falls back to the second key instead.
-- That is, create a new map where the second key's value is copied to the first key without overwriting.
fallback :: Ord k => k -> k -> M.Map k a -> M.Map k a
fallback :: k -> k -> Map k a -> Map k a
fallback k
from k
to Map k a
m
  | Just a
v <- k -> Map k a -> Maybe a
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup k
to Map k a
m = (a -> a -> a) -> k -> a -> Map k a -> Map k a
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith (\a
_ -> a -> a
forall a. a -> a
id) k
from a
v Map k a
m
  | Bool
otherwise = Map k a
m