87 lines
3.6 KiB
Haskell
87 lines
3.6 KiB
Haskell
module Utils.Parameters
|
|
( GlobalGetParam(..)
|
|
, lookupGlobalGetParam, hasGlobalGetParam, lookupGlobalGetParams
|
|
, lookupGlobalGetParamForm, hasGlobalGetParamForm
|
|
, globalGetParamField
|
|
, GlobalPostParam(..)
|
|
, lookupGlobalPostParam, hasGlobalPostParam, lookupGlobalPostParams
|
|
, lookupGlobalPostParamForm, hasGlobalPostParamForm
|
|
, globalPostParamField
|
|
) where
|
|
|
|
import ClassyPrelude.Yesod
|
|
|
|
import Utils.PathPiece
|
|
|
|
import qualified Data.Map as Map
|
|
|
|
import Data.Universe
|
|
|
|
import Control.Monad.Trans.Maybe (MaybeT(..))
|
|
|
|
|
|
data GlobalGetParam = GetReferer | GetBearer | GetRecipient
|
|
deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic)
|
|
|
|
instance Universe GlobalGetParam
|
|
instance Finite GlobalGetParam
|
|
nullaryPathPiece ''GlobalGetParam (camelToPathPiece' 1)
|
|
|
|
lookupGlobalGetParam :: (MonadHandler m, PathPiece result) => GlobalGetParam -> m (Maybe result)
|
|
lookupGlobalGetParam ident = (>>= fromPathPiece) <$> lookupGetParam (toPathPiece ident)
|
|
|
|
hasGlobalGetParam :: MonadHandler m => GlobalGetParam -> m Bool
|
|
hasGlobalGetParam ident = isJust <$> lookupGetParam (toPathPiece ident)
|
|
|
|
lookupGlobalGetParams :: (MonadHandler m, PathPiece result) => GlobalGetParam -> m [result]
|
|
lookupGlobalGetParams ident = mapMaybe fromPathPiece <$> lookupGetParams (toPathPiece ident)
|
|
|
|
|
|
lookupGlobalGetParamForm :: (Monad m, PathPiece result) => GlobalGetParam -> MForm m (Maybe result)
|
|
lookupGlobalGetParamForm ident = runMaybeT $ do
|
|
ps <- MaybeT askParams
|
|
MaybeT . return $ Map.lookup (toPathPiece ident) ps >>= listToMaybe >>= fromPathPiece
|
|
|
|
hasGlobalGetParamForm :: Monad m => GlobalGetParam -> MForm m Bool
|
|
hasGlobalGetParamForm ident = maybe False (Map.member $ toPathPiece ident) <$> askParams
|
|
|
|
globalGetParamField :: Monad m => GlobalGetParam -> Field m a -> MForm m (Maybe a)
|
|
globalGetParamField ident Field{fieldParse} = runMaybeT $ do
|
|
ts <- fromMaybe [] . Map.lookup (toPathPiece ident) <$> MaybeT askParams
|
|
fs <- fromMaybe [] . Map.lookup (toPathPiece ident) <$> MaybeT askFiles
|
|
MaybeT $ either (const Nothing) id <$> lift (fieldParse ts fs)
|
|
|
|
data GlobalPostParam = PostFormIdentifier
|
|
| PostDeleteTarget
|
|
| PostMassInputShape
|
|
| PostBearer
|
|
deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic)
|
|
|
|
instance Universe GlobalPostParam
|
|
instance Finite GlobalPostParam
|
|
nullaryPathPiece ''GlobalPostParam (camelToPathPiece' 1)
|
|
|
|
lookupGlobalPostParam :: (MonadHandler m, PathPiece result) => GlobalPostParam -> m (Maybe result)
|
|
lookupGlobalPostParam ident = (>>= fromPathPiece) <$> lookupPostParam (toPathPiece ident)
|
|
|
|
hasGlobalPostParam :: MonadHandler m => GlobalPostParam -> m Bool
|
|
hasGlobalPostParam ident = isJust <$> lookupPostParam (toPathPiece ident)
|
|
|
|
lookupGlobalPostParams :: (MonadHandler m, PathPiece result) => GlobalPostParam -> m [result]
|
|
lookupGlobalPostParams ident = mapMaybe fromPathPiece <$> lookupPostParams (toPathPiece ident)
|
|
|
|
|
|
lookupGlobalPostParamForm :: (Monad m, PathPiece result) => GlobalPostParam -> MForm m (Maybe result)
|
|
lookupGlobalPostParamForm ident = runMaybeT $ do
|
|
ps <- MaybeT askParams
|
|
MaybeT . return $ Map.lookup (toPathPiece ident) ps >>= listToMaybe >>= fromPathPiece
|
|
|
|
hasGlobalPostParamForm :: Monad m => GlobalPostParam -> MForm m Bool
|
|
hasGlobalPostParamForm ident = maybe False (Map.member $ toPathPiece ident) <$> askParams
|
|
|
|
globalPostParamField :: Monad m => GlobalPostParam -> Field m a -> MForm m (Maybe a)
|
|
globalPostParamField ident Field{fieldParse} = runMaybeT $ do
|
|
ts <- fromMaybe [] . Map.lookup (toPathPiece ident) <$> MaybeT askParams
|
|
fs <- fromMaybe [] . Map.lookup (toPathPiece ident) <$> MaybeT askFiles
|
|
MaybeT $ either (const Nothing) id <$> lift (fieldParse ts fs)
|