module Handler.School where

import Import
import Handler.Utils
import Handler.Utils.Table.Columns

import qualified Database.Esqueleto as E

getSchoolListR :: Handler Html
getSchoolListR = do
  let
    schoolLink :: SchoolId -> SomeRoute UniWorX
    schoolLink ssh = SomeRoute $ SchoolShowR ssh
    
    dbtSQLQuery :: E.SqlExpr (Entity School) -> E.SqlQuery _
    dbtSQLQuery = return

    dbtProj :: DBRow _ -> MaybeT (YesodDB UniWorX) (DBRow (Entity School))
    dbtProj = return

    dbtRowKey = (E.^. SchoolId)

    dbtColonnade :: Colonnade Sortable _ _
    dbtColonnade = mconcat
      [ colSchoolShort $ _dbrOutput . _entityKey
      , anchorColonnade (views (_dbrOutput . _entityKey) schoolLink) $ colSchoolName (_dbrOutput . _entityVal . _schoolName)
      ]

    dbtSorting = mconcat
      [ sortSchoolShort $ to (E.^. SchoolId)
      , sortSchoolName $ to (E.^. SchoolName)
      ]

    dbtFilter = mempty
    dbtFilterUI = mempty

    dbtStyle = def
    dbtParams = def

    dbtCsvEncode = noCsvEncode
    dbtCsvDecode = Nothing

    dbtIdent :: Text
    dbtIdent = "schools"

    psValidator = def
      & defaultSorting [SortAscBy "school-name"]
    

  table <- runDB $ dbTableWidget' psValidator DBTable{..}

  let title = MsgMenuSchoolList
  siteLayoutMsg title $ do
    setTitleI title
    table

data SchoolForm = SchoolForm
  { sfShorthand :: CI Text
  , sfName :: CI Text
  }

mkSchoolForm :: Maybe SchoolId -> Maybe SchoolForm -> Form SchoolForm
mkSchoolForm mSsh template = renderAForm FormStandard $ SchoolForm
  <$> maybe (\f fs -> areq f fs (sfShorthand <$> template)) (\ssh f fs -> aforced f fs (unSchoolKey ssh)) mSsh ciField (fslI MsgSchoolShort)
  <*> areq ciField (fslI MsgSchoolName) (sfName <$> template)

schoolToForm :: SchoolId -> DB (Form SchoolForm)
schoolToForm ssh = do
  School{..} <- get404 ssh
  return . mkSchoolForm (Just ssh) $ Just SchoolForm
    { sfShorthand = schoolShorthand
    , sfName = schoolName
    }


getSchoolShowR, postSchoolShowR :: SchoolId -> Handler Html
getSchoolShowR = postSchoolShowR
postSchoolShowR ssh = do
  sForm <- runDB $ schoolToForm ssh
  
  ((sfResult, sfView), sfEnctype) <- runFormPost sForm

  formResult sfResult $ \SchoolForm{..} -> do
    runDB $ do
      update ssh [ SchoolName =. sfName ]
      addMessageI Success $ MsgSchoolUpdated ssh
    redirect $ SchoolShowR ssh

  let sfView' = wrapForm sfView FormSettings
        { formMethod = POST
        , formAction = Just . SomeRoute $ SchoolShowR ssh
        , formEncoding = sfEnctype
        , formAttrs = []
        , formSubmit = FormSubmit
        , formAnchor = Nothing :: Maybe Text
        }

  siteLayoutMsg (MsgSchoolTitle ssh) $ do
    setTitleI $ MsgSchoolTitle ssh
    sfView'

getSchoolNewR, postSchoolNewR :: Handler Html
getSchoolNewR = postSchoolNewR
postSchoolNewR = do
  ((sfResult, sfView), sfEnctype) <- runFormPost $ mkSchoolForm Nothing Nothing

  formResult sfResult $ \SchoolForm{..} -> do
    let ssh = SchoolKey sfShorthand
    insertOkay <- runDB $ do
      fmap (is _Just) $ insertUnique School
        { schoolShorthand = sfShorthand
        , schoolName = sfName
        }

    if
      | insertOkay -> do
          addMessageI Success $ MsgSchoolCreated ssh
          redirect $ SchoolShowR ssh
      | otherwise
        -> addMessageI Error $ MsgSchoolExists ssh

  let sfView' = wrapForm sfView FormSettings
        { formMethod = POST
        , formAction = Just $ SomeRoute SchoolNewR
        , formEncoding = sfEnctype
        , formAttrs = []
        , formSubmit = FormSubmit
        , formAnchor = Nothing :: Maybe Text
        }

  siteLayoutMsg MsgTitleSchoolNew $ do
    setTitleI MsgTitleSchoolNew
    sfView'