-- |
-- Functionality specific to 'MonoidMap's over 'Method's.
module Web.Route.Invertible.Map.Method
  ( MethodMap
  , fallbackMethodHEADtoGET
  , fallbackDefaultMethodHEADtoGET
  , lookupMethod
  , lookupDefaultMethod
  ) where

import Prelude hiding (lookup)

import qualified Data.Map.Strict as M

import Web.Route.Invertible.Method
import Web.Route.Invertible.Map
import Web.Route.Invertible.Map.Monoid
import Web.Route.Invertible.Map.Default

-- |A 'MonoidMap' keyed on 'Method'
type MethodMap = MonoidMap Method

-- |If there is no value associated with 'HEAD', 'fallback' to the value associated with 'GET'.
fallbackMethodHEADtoGET :: MethodMap a -> MethodMap a
fallbackMethodHEADtoGET :: MethodMap a -> MethodMap a
fallbackMethodHEADtoGET = Map Method a -> MethodMap a
forall k a. Map k a -> MonoidMap k a
MonoidMap (Map Method a -> MethodMap a)
-> (MethodMap a -> Map Method a) -> MethodMap a -> MethodMap a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Method -> Method -> Map Method a -> Map Method a
forall k a. Ord k => k -> k -> Map k a -> Map k a
fallback Method
HEAD Method
GET (Map Method a -> Map Method a)
-> (MethodMap a -> Map Method a) -> MethodMap a -> Map Method a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MethodMap a -> Map Method a
forall k a. MonoidMap k a -> Map k a
monoidMap

-- |'fallbackMethodHEADtoGET' over 'DefaultMap'.
fallbackDefaultMethodHEADtoGET :: DefaultMap MethodMap a -> DefaultMap MethodMap a
fallbackDefaultMethodHEADtoGET :: DefaultMap MethodMap a -> DefaultMap MethodMap a
fallbackDefaultMethodHEADtoGET = (MonoidMap Method a -> MonoidMap Method a)
-> DefaultMap MethodMap a -> DefaultMap MethodMap a
forall (m :: * -> *) v (n :: * -> *).
(m v -> n v) -> DefaultMap m v -> DefaultMap n v
withDefaultMap MonoidMap Method a -> MonoidMap Method a
forall a. MethodMap a -> MethodMap a
fallbackMethodHEADtoGET

-- |Either the given value or the list of keys.
orKeys :: MethodMap a -> Maybe a -> Either [Method] a
orKeys :: MethodMap a -> Maybe a -> Either [Method] a
orKeys (MonoidMap Map Method a
m) = Either [Method] a
-> (a -> Either [Method] a) -> Maybe a -> Either [Method] a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Method] -> Either [Method] a
forall a b. a -> Either a b
Left ([Method] -> Either [Method] a) -> [Method] -> Either [Method] a
forall a b. (a -> b) -> a -> b
$ Map Method a -> [Method]
forall k a. Map k a -> [k]
M.keys Map Method a
m) a -> Either [Method] a
forall a b. b -> Either a b
Right

-- |Lookup a method in the map, returning either the associated value, or the list of keys.
-- This is useful for generating 405 results.
lookupMethod :: Method -> MethodMap a -> Either [Method] a
lookupMethod :: Method -> MethodMap a -> Either [Method] a
lookupMethod Method
s MethodMap a
m =
  MethodMap a -> Maybe a -> Either [Method] a
forall a. MethodMap a -> Maybe a -> Either [Method] a
orKeys MethodMap a
m (Maybe a -> Either [Method] a) -> Maybe a -> Either [Method] a
forall a b. (a -> b) -> a -> b
$ Method -> Map Method a -> Maybe a
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Method
s (Map Method a -> Maybe a) -> Map Method a -> Maybe a
forall a b. (a -> b) -> a -> b
$ MethodMap a -> Map Method a
forall k a. MonoidMap k a -> Map k a
monoidMap MethodMap a
m

-- |'lookupMethod' over 'DefaultMap'.
lookupDefaultMethod :: Method -> DefaultMap MethodMap a -> Either [Method] a
lookupDefaultMethod :: Method -> DefaultMap MethodMap a -> Either [Method] a
lookupDefaultMethod Method
s DefaultMap MethodMap a
d =
  MethodMap a -> Maybe a -> Either [Method] a
forall a. MethodMap a -> Maybe a -> Either [Method] a
orKeys (DefaultMap MethodMap a -> MethodMap a
forall (m :: * -> *) v. DefaultMap m v -> m v
defaultMap DefaultMap MethodMap a
d) (Maybe a -> Either [Method] a) -> Maybe a -> Either [Method] a
forall a b. (a -> b) -> a -> b
$ (MethodMap a -> Maybe a) -> DefaultMap MethodMap a -> Maybe a
forall (m :: * -> *) v.
(m v -> Maybe v) -> DefaultMap m v -> Maybe v
lookupDefault (Method -> Map Method a -> Maybe a
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Method
s (Map Method a -> Maybe a)
-> (MethodMap a -> Map Method a) -> MethodMap a -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MethodMap a -> Map Method a
forall k a. MonoidMap k a -> Map k a
monoidMap) DefaultMap MethodMap a
d