fourmolu formatting

0rphee · Jun 6, 2024 · 0180379 · 0180379
1 parent d8a8a78
commit 0180379
Show file tree

Hide file tree

Showing 4 changed files with 95 additions and 92 deletions.
diff --git a/src/PPrint.hs b/src/PPrint.hs
@@ -57,8 +57,8 @@ separateWith lineStyle lineChar numOfLines l r = l <> emptyLines <> separatingLi
 annotateErrors :: [Error] -> Doc AnsiStyle
 annotateErrors es =
   annotate
-    (color Red <> bold) $
-    concatWith (separateWith bold '-' 1) (map annotateError es) <> line
+    (color Red <> bold)
+    $ concatWith (separateWith bold '-' 1) (map annotateError es) <> line
 
 annotateSubjectList :: [IDandSubj] -> Doc AnsiStyle
 annotateSubjectList ss = concatWith (separateWith (colorDull Yellow) '-' 1) (map annotateSubject ss)

diff --git a/src/Types.hs b/src/Types.hs
@@ -3,16 +3,16 @@
 {-# LANGUAGE LambdaCase #-}
 
 module Types
-  ( Class (..),
-    Hour (..),
-    Minute (..),
-    Time (..),
-    Interval (..),
-    Subject (..),
-    IDandSubj (..),
-    Error (..),
-    minuteToInt,
-    getClassDayOffset,
+  ( Class (..)
+  , Hour (..)
+  , Minute (..)
+  , Time (..)
+  , Interval (..)
+  , Subject (..)
+  , IDandSubj (..)
+  , Error (..)
+  , minuteToInt
+  , getClassDayOffset
   )
 where
 
@@ -21,9 +21,9 @@ import Control.DeepSeq
 import Data.Aeson.Types (parseFail, prependFailure, typeMismatch)
 import Data.Text qualified as T
 import Data.Yaml
-  ( FromJSON (parseJSON),
-    Value (Object, String),
-    (.:),
+  ( FromJSON (parseJSON)
+  , Value (Object, String)
+  , (.:)
   )
 import Prettyprinter (Pretty (pretty), indent, line, vsep, (<+>))
 
@@ -140,8 +140,8 @@ instance Show Minute where
   {-# INLINE show #-}
 
 data Time = MkTime
-  { timeHour :: !Hour,
-    timeMinute :: !Minute
+  { timeHour :: !Hour
+  , timeMinute :: !Minute
   }
   deriving (Eq, Ord, Bounded)
 
@@ -255,8 +255,8 @@ instance Enum Time where
       MkTime H23 HalfAnHour -> 47
 
 data Interval = MkInterval
-  { intervalStartingTime :: !Time,
-    intervalEndTime :: !Time
+  { intervalStartingTime :: !Time
+  , intervalEndTime :: !Time
   }
 
 instance NFData Interval where
@@ -271,10 +271,10 @@ newtype IDandSubj
   deriving newtype (NFData)
 
 data Subject = MkSubject
-  { subjName :: !T.Text,
-    subjProfessor :: !T.Text,
-    subjclasses :: ![Class]
-    -- maybe will change to S.Seq
+  { subjName :: !T.Text
+  , subjProfessor :: !T.Text
+  , subjclasses :: ![Class]
+  -- maybe will change to S.Seq
   }
 
 instance NFData Subject where

diff --git a/src/Validation.hs b/src/Validation.hs
@@ -39,14 +39,14 @@ classesOverlap class1 class2 =
     (SaturdayClass inter1, SaturdayClass inter2) -> intervalsOverlap inter1 inter2
     _ -> False
 
-getMapsFromValues ::
-  [IDandSubj] -> Either Error (M.Map T.Text [T.Text], M.Map T.Text Subject)
+getMapsFromValues
+  :: [IDandSubj] -> Either Error (M.Map T.Text [T.Text], M.Map T.Text Subject)
 getMapsFromValues values = go values (Right (M.empty, M.empty))
   where
-    go ::
-      [IDandSubj] ->
-      Either Error (M.Map T.Text [T.Text], M.Map T.Text Subject) ->
-      Either Error (M.Map T.Text [T.Text], M.Map T.Text Subject)
+    go
+      :: [IDandSubj]
+      -> Either Error (M.Map T.Text [T.Text], M.Map T.Text Subject)
+      -> Either Error (M.Map T.Text [T.Text], M.Map T.Text Subject)
     go [] result = result
     go (IDandSubj (id', subj) : xs) res =
       do
@@ -60,10 +60,10 @@ getMapsFromValues values = go values (Right (M.empty, M.empty))
         alteringFunc (Just valueInside) = Just (id' : valueInside)
         alteringFunc Nothing = Just [id']
 
-genPossibleClassCombinations ::
-  (Applicative f) =>
-  M.Map T.Text (f T.Text) ->
-  f [T.Text] -- outpts the list of lists of ids as Text
+genPossibleClassCombinations
+  :: Applicative f
+  => M.Map T.Text (f T.Text)
+  -> f [T.Text] -- outpts the list of lists of ids as Text
 genPossibleClassCombinations = sequenceA . M.elems
 
 tuples :: Int -> [a] -> [[a]]

diff --git a/src/WriteiCal.hs b/src/WriteiCal.hs
@@ -11,8 +11,9 @@ import Data.Map.Strict as M
 import Data.Text qualified as TS
 import Data.Text.Lazy qualified as TL
 import Data.Time
+import Data.Time.Clock.System
+    ( systemToUTCTime, getSystemTime, systemToUTCTime )
 import Data.Time.Calendar.Easter (sundayAfter)
-import Data.Time.Clock.System (getSystemTime, systemToUTCTime)
 import Text.ICalendar hiding (Class)
 import Types
 
@@ -22,37 +23,37 @@ emptyVCalendar = def
 emptyVEvent :: VEvent
 emptyVEvent =
   VEvent
-    { veDTStamp = DTStamp (UTCTime (ModifiedJulianDay 1) (secondsToDiffTime 1)) def, -- date & time of creation
-      veUID = UID "" def,
-      veClass = def,
-      veDTStart = def,
-      veCreated = def,
-      veDescription = def,
-      veGeo = def,
-      veLastMod = def,
-      veLocation = def,
-      veOrganizer = def,
-      vePriority = def,
-      veSeq = def,
-      veStatus = def,
-      veSummary = def,
-      veTransp = def,
-      veUrl = def,
-      veRecurId = def,
-      veRRule = def,
-      veDTEndDuration = def,
-      veAttach = def,
-      veAttendee = def,
-      veCategories = def,
-      veComment = def,
-      veContact = def,
-      veExDate = def,
-      veRStatus = def,
-      veRelated = def,
-      veResources = def,
-      veRDate = def,
-      veAlarms = def,
-      veOther = def
+    { veDTStamp = DTStamp (UTCTime (ModifiedJulianDay 1) (secondsToDiffTime 1)) def -- date & time of creation
+    , veUID = UID "" def
+    , veClass = def
+    , veDTStart = def
+    , veCreated = def
+    , veDescription = def
+    , veGeo = def
+    , veLastMod = def
+    , veLocation = def
+    , veOrganizer = def
+    , vePriority = def
+    , veSeq = def
+    , veStatus = def
+    , veSummary = def
+    , veTransp = def
+    , veUrl = def
+    , veRecurId = def
+    , veRRule = def
+    , veDTEndDuration = def
+    , veAttach = def
+    , veAttendee = def
+    , veCategories = def
+    , veComment = def
+    , veContact = def
+    , veExDate = def
+    , veRStatus = def
+    , veRelated = def
+    , veResources = def
+    , veRDate = def
+    , veAlarms = def
+    , veOther = def
     }
 
 toVCal :: Day -> [IDandSubj] -> IO VCalendar
@@ -72,39 +73,40 @@ toVCal weekStartDay subjects = do
     vEventList = concat <$> traverse idandsubjToVEvents subjects
 
     idandsubjToVEvents :: IDandSubj -> IO [(TL.Text, VEvent)]
-    idandsubjToVEvents (IDandSubj (subId, subj)) = traverse (classToEvent subId subj.subjName subj.subjProfessor) subj.subjclasses
+    idandsubjToVEvents (IDandSubj (subId, subj)) =
+      traverse (classToEvent subId subj.subjName subj.subjProfessor) subj.subjclasses
 
     classToEvent :: TS.Text -> TS.Text -> TS.Text -> Class -> IO (TL.Text, VEvent) -- T.Text: UID value
     classToEvent subId name teacher individualClass = do
       uidText <- getUidText
-      pure $
-        ( uidText,
-          emptyVEvent
+      pure
+        ( uidText
+        , emptyVEvent
             { veSummary =
                 Just $
                   Summary
-                    { summaryValue = TL.fromStrict (name <> "(" <> subId <> ")"),
-                      summaryLanguage = def,
-                      summaryAltRep = def,
-                      summaryOther = def
-                    },
-              veUID = UID uidText def,
-              veDTStart = Just startDatetime,
-              veDTEndDuration = Just $ Left endDatetime,
-              veDescription =
+                    { summaryValue = TL.fromStrict (name <> "(" <> subId <> ")")
+                    , summaryLanguage = def
+                    , summaryAltRep = def
+                    , summaryOther = def
+                    }
+            , veUID = UID uidText def
+            , veDTStart = Just startDatetime
+            , veDTEndDuration = Just $ Left endDatetime
+            , veDescription =
                 Just $
                   Description
-                    { descriptionValue = TL.fromStrict teacher,
-                      descriptionLanguage = def,
-                      descriptionAltRep = def,
-                      descriptionOther = def
+                    { descriptionValue = TL.fromStrict teacher
+                    , descriptionLanguage = def
+                    , descriptionAltRep = def
+                    , descriptionOther = def
                     }
             }
         )
       where
         getUidText :: IO TL.Text
         getUidText = do
-          time <- TL.pack . show <$> getSystemTime
+          time <- TL.pack . formatTime defaultTimeLocale "%C:%y:%m:%dT:%H:%M:%S:%qZ" . systemToUTCTime <$> getSystemTime
           let res =
                 TL.fromStrict subId
                   <> "-"
@@ -121,25 +123,26 @@ toVCal weekStartDay subjects = do
         startDatetime :: DTStart
         startDatetime =
           DTStartDateTime
-            { dtStartDateTimeValue = buildDateTime individualClass.classInterval.intervalStartingTime,
-              dtStartOther = def
+            { dtStartDateTimeValue =
+                buildDateTime individualClass.classInterval.intervalStartingTime
+            , dtStartOther = def
             }
         endDatetime :: DTEnd
         endDatetime =
           DTEndDateTime
-            { dtEndDateTimeValue = buildDateTime individualClass.classInterval.intervalEndTime,
-              dtEndOther = def
+            { dtEndDateTimeValue = buildDateTime individualClass.classInterval.intervalEndTime
+            , dtEndOther = def
             }
         buildDateTime :: Time -> DateTime
         buildDateTime time =
           FloatingDateTime $
             LocalTime
-              { localDay = dayOfClass,
-                localTimeOfDay =
+              { localDay = dayOfClass
+              , localTimeOfDay =
                   TimeOfDay
-                    { todHour = fromEnum time.timeHour,
-                      todMin = minuteToInt time.timeMinute,
-                      todSec = 0
+                    { todHour = fromEnum time.timeHour
+                    , todMin = minuteToInt time.timeMinute
+                    , todSec = 0
                     }
               }