module Utils.Parameters
  ( GlobalGetParam(..)
  , lookupGlobalGetParam, hasGlobalGetParam, lookupGlobalGetParams
  , lookupGlobalGetParamForm, hasGlobalGetParamForm
  , globalGetParamField
  , GlobalPostParam(..)
  , lookupGlobalPostParam, hasGlobalPostParam, lookupGlobalPostParams
  , lookupGlobalPostParamForm, hasGlobalPostParamForm
  , globalPostParamField, globalPostParamFields
  ) 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
                     | PostDBCsvImportAction
  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)

globalPostParamFields :: Monad m => GlobalPostParam -> Field m a -> MForm m [a]
globalPostParamFields ident Field{fieldParse} = fmap (fromMaybe []) . runMaybeT $ do
  ts <- fromMaybe [] . Map.lookup (toPathPiece ident) <$> MaybeT askParams
  fs <- fromMaybe [] . Map.lookup (toPathPiece ident) <$> MaybeT askFiles
  forM ((Left <$> fs) ++ (Right <$> ts)) $ \inp -> MaybeT $ either (const Nothing) id <$> lift (either (\f -> fieldParse [] [f]) (\t -> fieldParse [t] []) inp)