From 01803794a40fabf412d7bb7bb7257dcc06848fda Mon Sep 17 00:00:00 2001 From: 0rphee <0rph3e@proton.me> Date: Thu, 6 Jun 2024 00:07:13 -0600 Subject: [PATCH] fourmolu formatting --- src/PPrint.hs | 4 +- src/Types.hs | 42 ++++++++-------- src/Validation.hs | 20 ++++---- src/WriteiCal.hs | 121 ++++++++++++++++++++++++---------------------- 4 files changed, 95 insertions(+), 92 deletions(-) diff --git a/src/PPrint.hs b/src/PPrint.hs index 070f336..7a1efca 100644 --- 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 index 01a872b..738d481 100644 --- 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 index 595dbb3..b288976 100644 --- 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 index 10acf7f..d42b0b7 100644 --- 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 } }