-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>
--
-- SPDX-License-Identifier: AGPL-3.0-or-later

module Utils.Parameters
  ( GlobalGetParam(..)
  , lookupGlobalGetParam, hasGlobalGetParam, lookupGlobalGetParams
  , lookupGlobalGetParamForm, hasGlobalGetParamForm
  , globalGetParamField
  , GlobalPostParam(..)
  , lookupGlobalPostParam, hasGlobalPostParam, lookupGlobalPostParams
  , lookupGlobalPostParamForm, hasGlobalPostParamForm
  , globalPostParamField, globalPostParamFields
  , withGlobalPostParam
  ) where

import ClassyPrelude.Yesod

import Utils.PathPiece

import qualified Data.Map as Map

import Data.Universe

import Control.Monad.Trans.Maybe (MaybeT(..))

import Control.Lens


data GlobalGetParam = GetLang
                    | GetReferer
                    | GetBearer
                    | GetRecipient
                    | GetCsvExampleData
                    | GetDryRun
                    | GetDownload
                    | GetError
                    | GetSelectTable
                    | GetGenerateToken
  deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic)
  deriving anyclass (Universe, Finite)

nullaryPathPiece' ''GlobalGetParam $ \n -> if
  | n == 'GetLang -> "_LANG"
  | otherwise     -> nameToPathPiece' 1 n

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 $ preview (_Right . _Just) <$> lift (fieldParse ts fs)

data GlobalPostParam = PostFormIdentifier
                     | PostDeleteTarget
                     | PostMassInputShape
                     | PostBearer
                     | PostDBCsvImportAction | PostDBCsvImportAvailableActions
                     | PostDBCsvReImport
                     | PostCourseUserAddConfirmAction | PostCourseUserAddConfirmAvailableActions
                     | PostLoginDummy
                     | PostExamAutoOccurrencePrevious
                     | PostLanguage
                     | PostDryRun
  deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic)
  deriving anyclass (Universe, Finite)

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 $ preview (_Right . _Just) <$> 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 $ preview (_Right . _Just) <$> lift (either (\f -> fieldParse [] [f]) (\t -> fieldParse [t] []) inp)

withGlobalPostParam :: PathPiece result => GlobalPostParam -> result -> (Html -> MForm m a) -> (Html -> MForm m a)
withGlobalPostParam (toPathPiece -> ident) (toPathPiece -> res) f csrf
  = f $ csrf <> [shamlet|<input type=hidden name=#{ident} value=#{res}>|]