diff --git a/src/Handler/LMS/Result.hs b/src/Handler/LMS/Result.hs index 66c3a7588..46891f27f 100644 --- a/src/Handler/LMS/Result.hs +++ b/src/Handler/LMS/Result.hs @@ -1,5 +1,4 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} -- needed for HasEntity instances -{-# OPTIONS -Wno-unused-top-binds #-} -- TODO: remove me, for debugging only module Handler.LMS.Result ( getLmsResultR, postLmsResultR diff --git a/src/Handler/LMS/Users.hs b/src/Handler/LMS/Users.hs index 6f541f030..d98c9c369 100644 --- a/src/Handler/LMS/Users.hs +++ b/src/Handler/LMS/Users.hs @@ -1,5 +1,4 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} -- needed for HasEntity instances -{-# OPTIONS -Wno-unused-top-binds #-} -- TODO: remove me, for debugging only module Handler.LMS.Users ( getLmsUsersR, postLmsUsersR diff --git a/src/Model/Types/Lms.hs b/src/Model/Types/Lms.hs index 59790590c..d9a58a646 100644 --- a/src/Model/Types/Lms.hs +++ b/src/Model/Types/Lms.hs @@ -11,6 +11,7 @@ import Import.NoModel import Database.Persist.Sql import qualified Database.Esqueleto.Legacy as E import qualified Data.Csv as Csv +import qualified Data.Time.Format as Time import Utils.Lens.TH newtype LmsIdent = LmsIdent { getLmsIdent :: Text } @@ -38,32 +39,7 @@ deriveJSON defaultOptions derivePersistFieldJSON ''LmsStatus --- LMS Interface requires Bool to be encoded by 0 or 1 only -{- -data LmsBool = LmsUnset | LmsSet - deriving (Eq, Ord, Read, Show, Generic, Typeable, NFData) - -lms2bool :: LmsBool -> Bool -lms2bool LmsUnset = False -lms2bool LmsSet = True -bool2lms :: Bool -> LmsBool -bool2lms False = LmsUnset -bool2lms True = LmsSet - -_lmsBool :: Iso' Bool LmsBool -_lmsBool = iso bool2lms lms2bool - -instance Csv.ToField LmsBool where - toField LmsUnset = "0" - toField LmsSet = "1" - -instance Csv.FromField LmsBool where - parseField i - | i == "0" = pure LmsUnset - | i == "1" = pure LmsSet - | otherwise = empty --} - +-- | LMS interface requires Bool to be encoded by 0 or 1 only newtype LmsBool = LmsBool { lms2bool :: Bool } deriving (Eq, Ord, Read, Show, Generic, Typeable) @@ -79,3 +55,25 @@ instance Csv.FromField LmsBool where | i == "0" = pure $ LmsBool False | i == "1" = pure $ LmsBool True | otherwise = empty + +-- | LMS interface requires day format not compliant with iso8601 +newtype LmsDay = LmsDay { lms2day :: Day } + deriving (Eq, Ord, Read, Show, Generic, Typeable) + +_lmsDay :: Iso' Day LmsDay +_lmsDay = iso LmsDay lms2day + +-- | Format for day for LMS interface +lmsDayFormat :: String +lmsDayFormat = "%d-%m-%Y" + +instance Csv.ToField LmsDay where + toField (LmsDay d) = Csv.toField $ Time.formatTime Time.defaultTimeLocale lmsDayFormat d -- TimeLocale should not matter; getTimeLocale requires MonadHandler + +instance Csv.FromField LmsDay where +-- parseField = fmap LmsDay . parseLmsDay <=< Csv.parseField +-- where parseLmsDay = Time.parseTimeM True Time.defaultTimeLocale lmsDayFormat + parseField i = do + s <- Csv.parseField i + d <- Time.parseTimeM True Time.defaultTimeLocale lmsDayFormat s + return $ LmsDay d