format

haskell · Feb 29, 2024 · 7cb9669 · 7cb9669
1 parent 95a89ee
commit 7cb9669
Show file tree

Hide file tree

Showing 40 changed files with 1,362 additions and 1,102 deletions.
diff --git a/lib/Data/Format.hs b/lib/Data/Format.hs
@@ -52,7 +52,7 @@ class IsoVariant f => Summish f where
     pVoid :: f Void
     (<++>) :: f a -> f b -> f (Either a b)
 
-parseReader :: (MonadFail m) => ReadP t -> String -> m t
+parseReader :: MonadFail m => ReadP t -> String -> m t
 parseReader readp s =
     case [t | (t, "") <- readP_to_S readp s] of
         [t] -> return t
@@ -75,7 +75,7 @@ formatShow fmt t =
         Nothing -> error "formatShow: bad value"
 
 -- | Parse a value in the format
-formatParseM :: (MonadFail m) => Format t -> String -> m t
+formatParseM :: MonadFail m => Format t -> String -> m t
 formatParseM format = parseReader $ formatReadP format
 
 instance IsoVariant Format where
@@ -119,7 +119,8 @@ instance Productish Format where
                 a <- ra
                 b <- rb
                 return (a, b)
-            in MkFormat sab rab
+        in
+            MkFormat sab rab
     (MkFormat sa ra) **> (MkFormat sb rb) =
         let
             s b = do
@@ -129,7 +130,8 @@ instance Productish Format where
             r = do
                 ra
                 rb
-            in MkFormat s r
+        in
+            MkFormat s r
     (MkFormat sa ra) <** (MkFormat sb rb) =
         let
             s a = do
@@ -140,7 +142,8 @@ instance Productish Format where
                 a <- ra
                 rb
                 return a
-            in MkFormat s r
+        in
+            MkFormat s r
 
 instance Summish Format where
     pVoid = MkFormat absurd pfail
@@ -149,7 +152,8 @@ instance Summish Format where
             sab (Left a) = sa a
             sab (Right b) = sb b
             rab = (fmap Left ra) +++ (fmap Right rb)
-            in MkFormat sab rab
+        in
+            MkFormat sab rab
 
 literalFormat :: String -> Format ()
 literalFormat s = MkFormat{formatShowM = \_ -> Just s, formatReadP = string s >> return ()}
@@ -160,7 +164,8 @@ specialCaseShowFormat (val, str) (MkFormat s r) =
         s' t
             | t == val = Just str
         s' t = s t
-        in MkFormat s' r
+    in
+        MkFormat s' r
 
 specialCaseFormat :: Eq a => (a, String) -> Format a -> Format a
 specialCaseFormat (val, str) (MkFormat s r) =
@@ -169,7 +174,8 @@ specialCaseFormat (val, str) (MkFormat s r) =
             | t == val = Just str
         s' t = s t
         r' = (string str >> return val) +++ r
-        in MkFormat s' r'
+    in
+        MkFormat s' r'
 
 optionalFormat :: Eq a => a -> Format a -> Format a
 optionalFormat val = specialCaseFormat (val, "")
@@ -180,7 +186,8 @@ casesFormat pairs =
         s t = lookup t pairs
         r [] = pfail
         r ((v, str) : pp) = (string str >> return v) <++ r pp
-        in MkFormat s $ r pairs
+    in
+        MkFormat s $ r pairs
 
 optionalSignFormat :: (Eq t, Num t) => Format t
 optionalSignFormat = casesFormat [(1, ""), (1, "+"), (0, ""), (-1, "-")]
@@ -232,8 +239,10 @@ showNumber signOpt mdigitcount t =
         showIt str =
             let
                 (intPart, decPart) = break ((==) '.') str
-                in (zeroPad mdigitcount intPart) ++ trimTrailing decPart
-        in case show t of
+            in
+                (zeroPad mdigitcount intPart) ++ trimTrailing decPart
+    in
+        case show t of
             ('-' : str) ->
                 case signOpt of
                     NoSign -> Nothing

diff --git a/lib/Data/Time/Calendar/Days.hs b/lib/Data/Time/Calendar/Days.hs
@@ -83,10 +83,12 @@ periodLength p = succ $ fromInteger $ diffDays (periodLastDay p) (periodFirstDay
 --
 -- @since 1.12.1
 periodFromDay :: DayPeriod p => Day -> (p, Int)
-periodFromDay d = let
-    p = dayPeriod d
-    dt = succ $ fromInteger $ diffDays d $ periodFirstDay p
-    in (p, dt)
+periodFromDay d =
+    let
+        p = dayPeriod d
+        dt = succ $ fromInteger $ diffDays d $ periodFirstDay p
+    in
+        (p, dt)
 
 -- | Inverse of 'periodFromDay'.
 --
@@ -98,9 +100,11 @@ periodToDay p i = addDays (toInteger $ pred i) $ periodFirstDay p
 --
 -- @since 1.12.1
 periodToDayValid :: DayPeriod p => p -> Int -> Maybe Day
-periodToDayValid p i = let
-    d = periodToDay p i
-    in if fst (periodFromDay d) == p then Just d else Nothing
+periodToDayValid p i =
+    let
+        d = periodToDay p i
+    in
+        if fst (periodFromDay d) == p then Just d else Nothing
 
 instance DayPeriod Day where
     periodFirstDay = id

diff --git a/lib/Data/Time/Calendar/Gregorian.hs b/lib/Data/Time/Calendar/Gregorian.hs
@@ -133,44 +133,52 @@ addGregorianDurationRollOver (CalendarDiffDays m d) day = addDays d $ addGregori
 
 -- | Calendrical difference, with as many whole months as possible
 diffGregorianDurationClip :: Day -> Day -> CalendarDiffDays
-diffGregorianDurationClip day2 day1 = let
-    (y1, m1, d1) = toGregorian day1
-    (y2, m2, d2) = toGregorian day2
-    ym1 = y1 * 12 + toInteger m1
-    ym2 = y2 * 12 + toInteger m2
-    ymdiff = ym2 - ym1
-    ymAllowed =
-        if day2 >= day1
-            then
-                if d2 >= d1
-                    then ymdiff
-                    else ymdiff - 1
-            else
-                if d2 <= d1
-                    then ymdiff
-                    else ymdiff + 1
-    dayAllowed = addGregorianDurationClip (CalendarDiffDays ymAllowed 0) day1
-    in CalendarDiffDays ymAllowed $ diffDays day2 dayAllowed
+diffGregorianDurationClip day2 day1 =
+    let
+        (y1, m1, d1) = toGregorian day1
+        (y2, m2, d2) = toGregorian day2
+        ym1 = y1 * 12 + toInteger m1
+        ym2 = y2 * 12 + toInteger m2
+        ymdiff = ym2 - ym1
+        ymAllowed =
+            if day2 >= day1
+                then
+                    if d2 >= d1
+                        then ymdiff
+                        else ymdiff - 1
+                else
+                    if d2 <= d1
+                        then ymdiff
+                        else ymdiff + 1
+        dayAllowed = addGregorianDurationClip (CalendarDiffDays ymAllowed 0) day1
+    in
+        CalendarDiffDays ymAllowed $ diffDays day2 dayAllowed
 
 -- | Calendrical difference, with as many whole months as possible.
 diffGregorianDurationRollOver :: Day -> Day -> CalendarDiffDays
-diffGregorianDurationRollOver day2 day1 = let
-    (y1, m1, _) = toGregorian day1
-    (y2, m2, _) = toGregorian day2
-    ym1 = y1 * 12 + toInteger m1
-    ym2 = y2 * 12 + toInteger m2
-    ymdiff = ym2 - ym1
-    findpos mdiff = let
-        dayAllowed = addGregorianDurationRollOver (CalendarDiffDays mdiff 0) day1
-        dd = diffDays day2 dayAllowed
-        in if dd >= 0 then CalendarDiffDays mdiff dd else findpos (pred mdiff)
-    findneg mdiff = let
-        dayAllowed = addGregorianDurationRollOver (CalendarDiffDays mdiff 0) day1
-        dd = diffDays day2 dayAllowed
-        in if dd <= 0 then CalendarDiffDays mdiff dd else findpos (succ mdiff)
-    in if day2 >= day1
-        then findpos ymdiff
-        else findneg ymdiff
+diffGregorianDurationRollOver day2 day1 =
+    let
+        (y1, m1, _) = toGregorian day1
+        (y2, m2, _) = toGregorian day2
+        ym1 = y1 * 12 + toInteger m1
+        ym2 = y2 * 12 + toInteger m2
+        ymdiff = ym2 - ym1
+        findpos mdiff =
+            let
+                dayAllowed = addGregorianDurationRollOver (CalendarDiffDays mdiff 0) day1
+                dd = diffDays day2 dayAllowed
+            in
+                if dd >= 0 then CalendarDiffDays mdiff dd else findpos (pred mdiff)
+        findneg mdiff =
+            let
+                dayAllowed = addGregorianDurationRollOver (CalendarDiffDays mdiff 0) day1
+                dd = diffDays day2 dayAllowed
+            in
+                if dd <= 0 then CalendarDiffDays mdiff dd else findpos (succ mdiff)
+    in
+        if day2 >= day1
+            then findpos ymdiff
+            else findneg ymdiff
 
 -- orphan instance
 instance Show Day where

diff --git a/lib/Data/Time/Calendar/Julian.hs b/lib/Data/Time/Calendar/Julian.hs
@@ -125,41 +125,49 @@ addJulianDurationRollOver (CalendarDiffDays m d) day = addDays d $ addJulianMont
 
 -- | Calendrical difference, with as many whole months as possible
 diffJulianDurationClip :: Day -> Day -> CalendarDiffDays
-diffJulianDurationClip day2 day1 = let
-    (y1, m1, d1) = toJulian day1
-    (y2, m2, d2) = toJulian day2
-    ym1 = y1 * 12 + toInteger m1
-    ym2 = y2 * 12 + toInteger m2
-    ymdiff = ym2 - ym1
-    ymAllowed =
-        if day2 >= day1
-            then
-                if d2 >= d1
-                    then ymdiff
-                    else ymdiff - 1
-            else
-                if d2 <= d1
-                    then ymdiff
-                    else ymdiff + 1
-    dayAllowed = addJulianDurationClip (CalendarDiffDays ymAllowed 0) day1
-    in CalendarDiffDays ymAllowed $ diffDays day2 dayAllowed
+diffJulianDurationClip day2 day1 =
+    let
+        (y1, m1, d1) = toJulian day1
+        (y2, m2, d2) = toJulian day2
+        ym1 = y1 * 12 + toInteger m1
+        ym2 = y2 * 12 + toInteger m2
+        ymdiff = ym2 - ym1
+        ymAllowed =
+            if day2 >= day1
+                then
+                    if d2 >= d1
+                        then ymdiff
+                        else ymdiff - 1
+                else
+                    if d2 <= d1
+                        then ymdiff
+                        else ymdiff + 1
+        dayAllowed = addJulianDurationClip (CalendarDiffDays ymAllowed 0) day1
+    in
+        CalendarDiffDays ymAllowed $ diffDays day2 dayAllowed
 
 -- | Calendrical difference, with as many whole months as possible.
 diffJulianDurationRollOver :: Day -> Day -> CalendarDiffDays
-diffJulianDurationRollOver day2 day1 = let
-    (y1, m1, _) = toJulian day1
-    (y2, m2, _) = toJulian day2
-    ym1 = y1 * 12 + toInteger m1
-    ym2 = y2 * 12 + toInteger m2
-    ymdiff = ym2 - ym1
-    findpos mdiff = let
-        dayAllowed = addJulianDurationRollOver (CalendarDiffDays mdiff 0) day1
-        dd = diffDays day2 dayAllowed
-        in if dd >= 0 then CalendarDiffDays mdiff dd else findpos (pred mdiff)
-    findneg mdiff = let
-        dayAllowed = addJulianDurationRollOver (CalendarDiffDays mdiff 0) day1
-        dd = diffDays day2 dayAllowed
-        in if dd <= 0 then CalendarDiffDays mdiff dd else findpos (succ mdiff)
-    in if day2 >= day1
-        then findpos ymdiff
-        else findneg ymdiff
+diffJulianDurationRollOver day2 day1 =
+    let
+        (y1, m1, _) = toJulian day1
+        (y2, m2, _) = toJulian day2
+        ym1 = y1 * 12 + toInteger m1
+        ym2 = y2 * 12 + toInteger m2
+        ymdiff = ym2 - ym1
+        findpos mdiff =
+            let
+                dayAllowed = addJulianDurationRollOver (CalendarDiffDays mdiff 0) day1
+                dd = diffDays day2 dayAllowed
+            in
+                if dd >= 0 then CalendarDiffDays mdiff dd else findpos (pred mdiff)
+        findneg mdiff =
+            let
+                dayAllowed = addJulianDurationRollOver (CalendarDiffDays mdiff 0) day1
+                dd = diffDays day2 dayAllowed
+            in
+                if dd <= 0 then CalendarDiffDays mdiff dd else findpos (succ mdiff)
+    in
+        if day2 >= day1
+            then findpos ymdiff
+            else findneg ymdiff
diff --git a/lib/Data/Time/Calendar/OrdinalDate.hs b/lib/Data/Time/Calendar/OrdinalDate.hs
@@ -115,18 +115,20 @@ fromMondayStartWeek ::
     -- Monday is 1, Sunday is 7 (as @%u@ in 'Data.Time.Format.formatTime').
     Int ->
     Day
-fromMondayStartWeek year w d = let
-    -- first day of the year
-    firstDay = fromOrdinalDate year 1
-    -- 0-based year day of first monday of the year
-    zbFirstMonday = (5 - toModifiedJulianDay firstDay) `mod` 7
-    -- 0-based week of year
-    zbWeek = w - 1
-    -- 0-based day of week
-    zbDay = d - 1
-    -- 0-based day in year
-    zbYearDay = zbFirstMonday + 7 * toInteger zbWeek + toInteger zbDay
-    in addDays zbYearDay firstDay
+fromMondayStartWeek year w d =
+    let
+        -- first day of the year
+        firstDay = fromOrdinalDate year 1
+        -- 0-based year day of first monday of the year
+        zbFirstMonday = (5 - toModifiedJulianDay firstDay) `mod` 7
+        -- 0-based week of year
+        zbWeek = w - 1
+        -- 0-based day of week
+        zbDay = d - 1
+        -- 0-based day in year
+        zbYearDay = zbFirstMonday + 7 * toInteger zbWeek + toInteger zbDay
+    in
+        addDays zbYearDay firstDay
 
 fromMondayStartWeekValid ::
     -- | Year.
@@ -173,18 +175,20 @@ fromSundayStartWeek ::
     -- Sunday is 0, Saturday is 6 (as @%w@ in 'Data.Time.Format.formatTime').
     Int ->
     Day
-fromSundayStartWeek year w d = let
-    -- first day of the year
-    firstDay = fromOrdinalDate year 1
-    -- 0-based year day of first monday of the year
-    zbFirstSunday = (4 - toModifiedJulianDay firstDay) `mod` 7
-    -- 0-based week of year
-    zbWeek = w - 1
-    -- 0-based day of week
-    zbDay = d
-    -- 0-based day in year
-    zbYearDay = zbFirstSunday + 7 * toInteger zbWeek + toInteger zbDay
-    in addDays zbYearDay firstDay
+fromSundayStartWeek year w d =
+    let
+        -- first day of the year
+        firstDay = fromOrdinalDate year 1
+        -- 0-based year day of first monday of the year
+        zbFirstSunday = (4 - toModifiedJulianDay firstDay) `mod` 7
+        -- 0-based week of year
+        zbWeek = w - 1
+        -- 0-based day of week
+        zbDay = d
+        -- 0-based day in year
+        zbYearDay = zbFirstSunday + 7 * toInteger zbWeek + toInteger zbDay
+    in
+        addDays zbYearDay firstDay
 
 fromSundayStartWeekValid ::
     -- | Year.