module Handler.Material where

import Import

import Data.Set (Set)
import qualified Data.Set as Set
import qualified Data.Conduit.List as C
-- import qualified Data.CaseInsensitive as CI

import qualified Database.Esqueleto as E

import Utils.Lens
import Utils.Form
import Handler.Utils

import Control.Monad.Writer (MonadWriter(..), execWriterT)



data MaterialForm = MaterialForm
      { mfName         :: MaterialName
      , mfType         :: Maybe Text
      , mfDescription  :: Maybe Html
      , mfVisibleFrom  :: Maybe UTCTime
      , mfFiles        :: Maybe (Source Handler (Either FileId File))
      }

makeMaterialForm :: CourseId -> Maybe MaterialForm -> Form MaterialForm
makeMaterialForm cid template = identifyForm FIDmaterial $ \html -> do
  MsgRenderer mr <- getMsgRenderer
  let setIds :: Either FileId File -> Set FileId
      setIds = either Set.singleton $ const Set.empty
      oldFileIds
        | Just source <- template >>= mfFiles
                    = runConduit $ source .| C.foldMap setIds
        | otherwise = return Set.empty
      typeOptions :: WidgetT UniWorX IO (Set Text)
      typeOptions = do
        let defaults = Set.fromList $ map mr [MsgMaterialTypeSlides,MsgMaterialTypeCode,MsgMaterialTypeExample]
        previouslyUsed <- liftHandlerT . runDB $
          E.select $ E.from $ \material ->
            E.distinctOnOrderBy [E.asc $ material E.^. MaterialType] $ do
              E.where_ $ (material E.^. MaterialCourse E.==. E.val cid)
                  E.&&.  (E.not_ $ E.isNothing $ material E.^. MaterialType)
              return $ material E.^. MaterialType
        return $ defaults <> (Set.fromList $ mapMaybe E.unValue previouslyUsed)

  ctime <- ceilingQuarterHour <$> liftIO getCurrentTime
  flip (renderAForm FormStandard) html $ MaterialForm
      <$> areq ciField        (fslI MsgMaterialName)         (mfName        <$> template)
      <*> aopt (textField & addDatalist typeOptions)
                              (fslpI MsgMaterialType $ mr MsgMaterialTypePlaceholder)
                                                             (mfType        <$> template)
      <*> aopt htmlField      (fslpI MsgMaterialDescription "Html")
                                                             (mfDescription <$> template)
      <*> aopt utcTimeField   (fslI MsgMaterialVisibleFrom
            & setTooltip MsgMaterialVisibleFromTip)         ((mfVisibleFrom  <$> template) <|> pure (Just ctime))
      <*> aopt (multiFileField oldFileIds)
                              (fslI MsgMaterialFiles)        (mfFiles <$> template)

getMaterialListR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
getMaterialListR = error "unimplemented" -- TODO


getMShowR :: TermId -> SchoolId -> CourseShorthand -> MaterialName -> Handler Html
getMShowR = error "unimplemented" -- TODO

getMEditR, postMEditR :: TermId -> SchoolId -> CourseShorthand -> MaterialName -> Handler Html
getMEditR = postMEditR
postMEditR tid ssh csh mnm = do
  (cid, Entity mid Material{..}, files) <- runDB $ do
    [(E.Value cid, matEnt)] <- E.select . E.from  $ -- uniqueness guaranteed
      \(course `E.InnerJoin` material) -> do
        E.on     $ course   E.^. CourseId   E.==.   material E.^. MaterialCourse
        E.where_ $ course   E.^. CourseTerm      E.==. E.val tid
            E.&&.  course   E.^. CourseSchool    E.==. E.val ssh
            E.&&.  course   E.^. CourseShorthand E.==. E.val csh
            E.&&.  material E.^. MaterialName    E.==. E.val mnm
        return (course E.^. CourseId, material)
    fileIds <- E.select . E.from $ \(matFile `E.InnerJoin` file) -> do
      E.on     $ matFile  E.^. MaterialFileFile     E.==. file E.^. FileId
      E.where_ $ matFile  E.^. MaterialFileMaterial E.==. E.val (entityKey matEnt)
      return $ file E.^. FileId
    return (cid, matEnt, (Left . E.unValue) <$> fileIds)
  let template = Just $ MaterialForm
        { mfName         = materialName
        , mfType         = materialType
        , mfDescription  = materialDescription
        , mfVisibleFrom  = materialVisibleFrom
        , mfFiles        = Just $ yieldMany files
        }
  editWidget <- handleMaterialEdit tid ssh csh cid template $ uniqueReplace mid
  let headingLong  = prependCourseTitle tid ssh csh $ MsgMaterialEditHeading mnm
      headingShort = prependCourseTitle tid ssh csh $ MsgMaterialEditTitle   mnm
  siteLayoutMsg headingLong $ do
    setTitleI headingShort
    editWidget


getMaterialNewR, postMaterialNewR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
getMaterialNewR = postMaterialNewR
postMaterialNewR tid ssh csh = do
  Entity cid _ <- runDB . getBy404 $ TermSchoolCourseShort tid ssh csh
  editWidget <- handleMaterialEdit tid ssh csh cid Nothing insertUnique
  let headingLong  = prependCourseTitle tid ssh csh MsgMaterialNewHeading
      headingShort = prependCourseTitle tid ssh csh MsgMaterialNewTitle
  siteLayoutMsg headingLong $ do
    setTitleI headingShort
    editWidget

handleMaterialEdit :: TermId -> SchoolId -> CourseShorthand -> CourseId -> Maybe MaterialForm -> (Material -> DB (Maybe MaterialId)) -> Handler Widget
handleMaterialEdit tid ssh csh cid template dbMaterial = do
    ((res,formWidget), formEnctype) <- runFormPost $ makeMaterialForm cid template
    formResult res saveMaterial
    -- actionUrl <- fromMaybe (CourseR tid ssh csh MaterialNewR) <$> getCurrentRoute
    return $ wrapForm formWidget def
        { formAction   = Nothing -- Just $ SomeRoute actionUrl
        , formEncoding = formEnctype
        }
  where
    saveMaterial :: MaterialForm -> Handler ()
    saveMaterial MaterialForm{..} = do
      _aid <- requireAuthId
      now <- liftIO getCurrentTime
      let newMaterial = Material
            { materialCourse      = cid
            , materialName        = mfName
            , materialType        = mfType
            , materialDescription = mfDescription
            , materialVisibleFrom = mfVisibleFrom
            , materialLastEdit    = now
            }
      saveOk <- runDB $ do
        mbmid <- dbMaterial newMaterial
        case mbmid of
          Nothing -> False <$ addMessageI Error (MsgMaterialNameDup tid ssh csh mfName)
          (Just mid) -> do -- save files in DB
            whenIsJust mfFiles $ insertMaterialFile' mid
            addMessageI Success $ MsgMaterialSaveOk tid ssh csh mfName
            -- more info/warnings could go here
            return True
      when saveOk $ redirect -- redirect must happen outside of runDB
        $ CourseR tid ssh csh (MaterialR mfName MShowR)

    insertMaterialFile' :: MaterialId -> Source Handler (Either FileId File) -> DB ()
    insertMaterialFile' mid fs = do
        oldFileIdVals <- E.select . E.from $ \(file `E.InnerJoin` materialFile) -> do
          E.on     $  materialFile E.^. MaterialFileFile E.==. file E.^. FileId
          E.where_ $  materialFile E.^. MaterialFileMaterial E.==. E.val mid
          return $ file E.^. FileId
        let oldFileIds = setFromList $ map E.unValue oldFileIdVals
        keep <- execWriterT . runConduit $ transPipe (lift . lift) fs =$= C.mapM_ finsert
        mapM_ deleteCascade $ (oldFileIds \\ keep :: Set FileId)
      where
        finsert (Left fileId) = tell $ singleton fileId
        finsert (Right file) = lift $ do
          fid <- insert file
          void . insert $ MaterialFile mid fid -- cannot fail due to uniqueness, since we generated a fresh FileId in the previous step


getMDelR, postMDelR :: TermId -> SchoolId -> CourseShorthand ->  MaterialName -> Handler Html
getMDelR = postMDelR
postMDelR = error "unimplemented" -- TODO