chore(lms): add newtype for special day format (not yet used)

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 

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 

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