replace String with Text in Validation #8

plexams-cli/Plexams/CLI/Commands.hs

@@ -1,8 +1,11 @@
+{-# LANGUAGE OverloadedStrings #-}
 module Plexams.CLI.Commands
   ( runCommand
   ) where
 
 import           Data.List                   (intercalate)
+import qualified Data.Text                   as Text
+import qualified Data.Text.IO                as Text
 import           Plexams.CLI.Types
 import           Plexams.Export.HTML
 import           Plexams.Export.Markdown
@@ -50,7 +53,8 @@ validate config = stdoutOrFile config . validate'
   where
     validate' plan =
       let (ok, msgs) = P.validate plan
-      in "\n# " ++ show ok ++ "\n\n" ++ intercalate "\n\n" msgs
+      in "\n# " ++ show ok ++ "\n\n" ++ intercalate "\n\n"
+                                                    (map Text.unpack msgs)
 
 query :: Config -> Plan -> IO ()
 query config plan = stdoutOrFile config
@@ -73,7 +77,7 @@ export config plan =
         Nothing -> return ()
         Just fp -> do
           (valRes, msgs) <- P.validateZPAExport fp plan
-          putStrLn $ intercalate "\n\n" msgs
+          Text.putStrLn $ Text.intercalate "\n\n" msgs
           print valRes
     Export Handicaps ->
       stdoutOrFile config $ exportHandicaps plan

plexams-cli/plexams-cli.cabal

@@ -43,6 +43,7 @@ library
                      , plexams-core
                      , plexams-generators
                      , plexams-gui
+                     , text
                      , time
                      , containers
   default-language:    Haskell2010

plexams-core/Plexams/Types.hs

@@ -1,4 +1,5 @@
-{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DeriveGeneric     #-}
+{-# LANGUAGE OverloadedStrings #-}
 module Plexams.Types
     ( -- * Config
       SemesterConfig(..)
@@ -69,12 +70,14 @@ import           Data.Char          (digitToInt)
 import           Data.List          (intercalate, partition, sortBy, (\\))
 import qualified Data.Map           as M
 import           Data.Maybe         (isJust, mapMaybe)
+import           Data.Monoid        ((<>))
 import           Data.Ord           (Down (Down), comparing)
 import qualified Data.Set           as S
 import           Data.Text          (Text, unpack)
 import           Data.Time.Calendar
 import           GHC.Exts           (groupWith)
 import           GHC.Generics
+import           TextShow           (TextShow, showb)
 
 
 data SemesterConfig = SemesterConfig
@@ -322,15 +325,35 @@ instance Show Group where
       ++ maybe "" show mS
       ++ maybe "" (("("++) . (++")") . show) mReg
 
+instance TextShow Group where
+  showb (Group d mI mS mReg) = showb d
+    <> maybe "" showb mI
+    <> maybe "" showb mS
+    <> maybe "" (("("<>) . (<>")") . showb) mReg
+
 data Degree = IB | IC | IF | GO | IG | IN | IS
   deriving (Show, Eq, Ord, Read, Enum)
 
+instance TextShow Degree where
+  showb IB = "IB"
+  showb IC = "IC"
+  showb IF = "IF"
+  showb GO = "GO"
+  showb IG = "IG"
+  showb IN = "IN"
+  showb IS = "IS"
+
 allDegrees :: [Degree]
 allDegrees = [IB .. IS]
 
 data Subgroup = A | B | C
   deriving (Show, Eq, Ord)
 
+instance TextShow Subgroup where
+  showb A = "A"
+  showb B = "B"
+  showb C = "C"
+
 instance Read Group where
     readsPrec _ str = [(parseGroup str, "")]
 
@@ -371,6 +394,10 @@ data Person = Person
     }
   deriving (Eq, Show, Ord)
 
+instance TextShow Person where
+  showb (Person id shortName _) =
+    showb id <> ". " <> showb shortName
+
 data AddExamToSlot =
     AddExamToSlot
       { planManipAnCode :: Integer

plexams-core/Plexams/Validation.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE OverloadedStrings #-}
 module Plexams.Validation
     ( validate
     , module Plexams.Validation.Exports
@@ -8,18 +9,20 @@ import           Control.Monad.Writer
 import           Data.List                         (nub)
 import qualified Data.Map                          as M
 import           Data.Maybe                        (isJust, mapMaybe)
+import           Data.Text                         (Text, append)
 import           GHC.Exts                          (groupWith)
 import           Plexams.Query
 import           Plexams.Types
 import           Plexams.Validation.Exports
 import qualified Plexams.Validation.Rooms
 import qualified Plexams.Validation.ScheduledExams
 import qualified Plexams.Validation.Sources
+import           TextShow                          (showt)
 
-validate :: Plan -> (ValidationResult, [String])
+validate :: Plan -> (ValidationResult, [Text])
 validate = runWriter . validate'
 
-validate' :: Plan -> Writer [String] ValidationResult
+validate' :: Plan -> Writer [Text] ValidationResult
 validate' plan = do
   tell ["# Validation"]
   sourcesOk <- Plexams.Validation.Sources.validate plan
@@ -34,7 +37,7 @@ validate' plan = do
             , roomsOk
             ]
 
-validateLecturersMax3ExamDays :: Plan -> Writer [String] ValidationResult
+validateLecturersMax3ExamDays :: Plan -> Writer [Text] ValidationResult
 validateLecturersMax3ExamDays plan = do
   let lecturerWithMoreThan3ExamDays =
           filter ((>3) . length . nub . snd) $ lecturerExamDays plan
@@ -43,7 +46,8 @@ validateLecturersMax3ExamDays plan = do
   unless ok $
     mapM_ (\(l,d) ->
               tell ["- More than 3 days of exams: "
-                    ++ personShortName l
-                    ++ ": " ++ show d])
+                    `append` showt (personShortName l)
+                    `append` ": "
+                    `append` showt d])
           lecturerWithMoreThan3ExamDays
   return $ if ok then EverythingOk else SoftConstraintsBroken

plexams-core/Plexams/Validation/Exports.hs

@@ -1,74 +1,77 @@
+{-# LANGUAGE OverloadedStrings #-}
 module Plexams.Validation.Exports
   ( validateZPAExport
   ) where
 
 import           Control.Monad.Writer
+import           Data.Text            (Text, append)
 import           Plexams.Import.Misc  (importZPAExamsFromJSONFile)
 import           Plexams.Types
+import           TextShow             (showt)
 
-validateZPAExport :: FilePath -> Plan -> IO (ValidationResult, [String])
+validateZPAExport :: FilePath -> Plan -> IO (ValidationResult, [Text])
 validateZPAExport fp plan = do
   maybeZpaExams <- importZPAExamsFromJSONFile fp
   case maybeZpaExams of
     Nothing -> return ( HardConstraintsBroken
-                      , ["ZPAExams cannot be imported from "++ fp])
+                      , ["ZPAExams cannot be imported from " `append` showt fp])
     Just zpaExams -> return $ runWriter $ validate zpaExams plan
 
 validate :: [ZPAExam] -> Plan
-         -> Writer [String] ValidationResult
+         -> Writer [Text] ValidationResult
 validate zpaExams plan = do
   tell ["# Validating ZPA export"]
   allOk <- allZPAExamsInExams zpaExams plan
   allExported <- allPlannedExamsInZPAExams zpaExams plan
   return $ validationResult [allOk, allExported]
 
 allZPAExamsInExams :: [ZPAExam] -> Plan
-                   -> Writer [String] ValidationResult
+                   -> Writer [Text] ValidationResult
 allZPAExamsInExams zpaExams plan =
     validationResult <$> mapM (`zpaExamInExams` allExams plan) zpaExams
   where
     zpaExamInExams :: ZPAExam -> [Exam]
-                   -> Writer [String] ValidationResult
+                   -> Writer [Text] ValidationResult
     zpaExamInExams zpaExam exams =
       case filter ((== zpaExamAnCode zpaExam) . anCode) exams of
         [] -> do
-          tell ["Exported exam " ++ show (zpaExamAnCode zpaExam)
-                ++ " does not exist"]
+          tell ["Exported exam " `append` showt (zpaExamAnCode zpaExam)
+                `append` " does not exist"]
           return HardConstraintsBroken
         [exam] -> do
           plannedByMeOk <-
             if plannedByMe exam
             then return EverythingOk
             else do
-              tell ["Exported exam " ++ show (zpaExamAnCode zpaExam)
-                    ++ " is not planned by me"]
+              tell ["Exported exam " `append` showt (zpaExamAnCode zpaExam)
+                    `append` " is not planned by me"]
               return HardConstraintsBroken
           dayOk <-
             if zpaExamDate zpaExam == examDateAsString exam plan
             then return EverythingOk
             else do
-                tell ["Exported exam " ++ show (zpaExamAnCode zpaExam)
-                      ++ " has wrong date"]
+                tell ["Exported exam " `append` showt (zpaExamAnCode zpaExam)
+                      `append` " has wrong date"]
                 return HardConstraintsBroken
           slotOk <-
             if zpaExamTime zpaExam == examSlotAsString exam plan
             then return EverythingOk
             else do
-                tell ["Exported exam " ++ show (zpaExamAnCode zpaExam)
-                      ++ " has wrong time"]
+                tell ["Exported exam " `append` showt (zpaExamAnCode zpaExam)
+                      `append` " has wrong time"]
                 return HardConstraintsBroken
           return $ validationResult [plannedByMeOk, dayOk, slotOk]
 
 allPlannedExamsInZPAExams :: [ZPAExam] -> Plan
-                          -> Writer [String] ValidationResult
+                          -> Writer [Text] ValidationResult
 allPlannedExamsInZPAExams zpaExams plan = do
     let examsPlannedByMe = filter plannedByMe $ allExams plan
     validationResult <$> mapM (`examExported` zpaExams) examsPlannedByMe
   where
-    examExported :: Exam -> [ZPAExam] -> Writer [String] ValidationResult
+    examExported :: Exam -> [ZPAExam] -> Writer [Text] ValidationResult
     examExported exam zpaExams =
       if anCode exam `elem` map zpaExamAnCode zpaExams
       then return EverythingOk
       else do
-        tell ["Exam " ++ show (anCode exam) ++ " not exported"]
+        tell ["Exam " `append` showt (anCode exam) `append` " not exported"]
         return HardConstraintsBroken

plexams-core/Plexams/Validation/Rooms.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE OverloadedStrings #-}
 module Plexams.Validation.Rooms
   ( validate
   ) where
@@ -8,11 +9,13 @@ import           Data.List            (nub)
 import qualified Data.Map             as M
 import           Data.Maybe           (isJust, mapMaybe)
 import qualified Data.Set             as S
+import           Data.Text            (Text, append)
 import           GHC.Exts             (groupWith)
 import           Plexams.Query
 import           Plexams.Types
+import           TextShow             (showt)
 
-validate :: Plan -> Writer [String] ValidationResult
+validate :: Plan -> Writer [Text] ValidationResult
 validate plan = do
   tell ["## Validating Rooms"]
   enoughRoomsForExams <- validateEnoughRoomsForExams plan
@@ -24,46 +27,47 @@ validate plan = do
             , differentRoomsInSlot
             ]
 
-validateEnoughRoomsForExams :: Plan -> Writer [String] ValidationResult
+validateEnoughRoomsForExams :: Plan -> Writer [Text] ValidationResult
 validateEnoughRoomsForExams plan = do
   tell ["### Validating enough rooms for exam (hard)"]
   validationResult <$> mapM validateEnoughRoomsForExam
                             (filter plannedByMe $ scheduledExams plan)
 
-validateEnoughRoomsForExam :: Exam -> Writer [String] ValidationResult
+validateEnoughRoomsForExam :: Exam -> Writer [Text] ValidationResult
 validateEnoughRoomsForExam exam = do
   let regs = registrations exam
       seats = sum $ map maxSeats $ rooms exam
   when (regs>seats) $
-    tell ["- exam " ++ show exam ++ " not enough rooms planned"]
+    tell ["- exam " `append` showt (anCode exam)
+                    `append` " not enough rooms planned"]
   return $ if regs<=seats
            then EverythingOk
            else HardConstraintsBroken
 
-validationStillReserveForExams :: Plan -> Writer [String] ValidationResult
+validationStillReserveForExams :: Plan -> Writer [Text] ValidationResult
 validationStillReserveForExams plan = do
   tell ["### Validating if there are at least 2 empty seats left for exam (soft)"]
   validationResult <$> mapM validationStillReserveForExam
                             (filter plannedByMe $ scheduledExams plan)
 
-validationStillReserveForExam :: Exam -> Writer [String] ValidationResult
+validationStillReserveForExam :: Exam -> Writer [Text] ValidationResult
 validationStillReserveForExam exam = do
   let regs = registrations exam
       seats = sum $ map maxSeats $ rooms exam
   when (regs+2>=seats) $
-    tell ["- exam " ++ show exam
-          ++ " not enough reserve seats left: "
-          ++ show regs ++"/" ++ show seats]
+    tell ["- exam " `append` showt (anCode exam)
+          `append` " not enough reserve seats left: "
+          `append` showt regs `append`"/" `append` showt seats]
   return $ if regs+2<=seats
            then EverythingOk
            else SoftConstraintsBroken
 
-validateDifferentRoomsInSlots :: Plan -> Writer [String] ValidationResult
+validateDifferentRoomsInSlots :: Plan -> Writer [Text] ValidationResult
 validateDifferentRoomsInSlots plan = do
   tell ["### Validating different rooms in slot (hard)"]
   validationResult <$> mapM validateDifferentRoomsInSlot (M.elems (slots plan))
 
-validateDifferentRoomsInSlot :: Slot -> Writer [String] ValidationResult
+validateDifferentRoomsInSlot :: Slot -> Writer [Text] ValidationResult
 validateDifferentRoomsInSlot slot = do
   tell ["TODO: fixme"]
   return HardConstraintsBroken