Merge pull request #270 from augustss/master

MicroHs has pattern synonyms now

.github/workflows/ci.mhs.yml

@@ -16,7 +16,7 @@ jobs:
         path: time
     - name: checkout mhs repo
       # workaround for `act`: https://github.com/nektos/act/issues/678#issuecomment-1693751996
-      run: git clone https://github.com/augustss/MicroHs.git --branch stable-2 mhs
+      run: git clone https://github.com/augustss/MicroHs.git --branch stable-4 mhs
     - name: make and install mhs
       run: |
         cd mhs

lib/Data/Time/Calendar/Gregorian.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE CPP #-}
 {-# LANGUAGE Safe #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 
@@ -7,12 +6,9 @@
 module Data.Time.Calendar.Gregorian (
     -- * Year, month and day
     Year,
-#ifdef __GLASGOW_HASKELL__
     pattern CommonEra,
     pattern BeforeCommonEra,
-#endif
     MonthOfYear,
-#ifdef __GLASGOW_HASKELL__
     pattern January,
     pattern February,
     pattern March,
@@ -25,15 +21,12 @@ module Data.Time.Calendar.Gregorian (
     pattern October,
     pattern November,
     pattern December,
-#endif
     DayOfMonth,
 
     -- * Gregorian calendar
     toGregorian,
     fromGregorian,
-#ifdef __GLASGOW_HASKELL__
     pattern YearMonthDay,
-#endif
     fromGregorianValid,
     showGregorian,
     gregorianMonthLength,
@@ -70,15 +63,13 @@ toGregorian date = (year, month, day)
 fromGregorian :: Year -> MonthOfYear -> DayOfMonth -> Day
 fromGregorian year month day = fromOrdinalDate year (monthAndDayToDayOfYear (isLeapYear year) month day)
 
-#if __GLASGOW_HASKELL__
 -- | Bidirectional abstract constructor for the proleptic Gregorian calendar.
 -- Invalid values will be clipped to the correct range, month first, then day.
 pattern YearMonthDay :: Year -> MonthOfYear -> DayOfMonth -> Day
 pattern YearMonthDay y m d <-
     (toGregorian -> (y, m, d))
     where
         YearMonthDay y m d = fromGregorian y m d
-#endif
 
 {-# COMPLETE YearMonthDay #-}
 
@@ -193,10 +184,8 @@ diffGregorianDurationRollOver day2 day1 =
 instance Show Day where
     show = showGregorian
 
-#ifdef __GLASGOW_HASKELL__
 -- orphan instance
 instance DayPeriod Year where
     periodFirstDay y = YearMonthDay y January 1
     periodLastDay y = YearMonthDay y December 31
     dayPeriod (YearMonthDay y _ _) = y
-#endif

lib/Data/Time/Calendar/Julian.hs

@@ -1,10 +1,8 @@
-{-# LANGUAGE CPP #-}
 {-# LANGUAGE Safe #-}
 
 module Data.Time.Calendar.Julian (
     Year,
     MonthOfYear,
-#ifdef __GLASGOW_HASKELL__
     pattern January,
     pattern February,
     pattern March,
@@ -17,15 +15,12 @@ module Data.Time.Calendar.Julian (
     pattern October,
     pattern November,
     pattern December,
-#endif
     DayOfMonth,
     DayOfYear,
     module Data.Time.Calendar.JulianYearDay,
     toJulian,
     fromJulian,
-#ifdef __GLASGOW_HASKELL__
     pattern JulianYearMonthDay,
-#endif
     fromJulianValid,
     showJulian,
     julianMonthLength,
@@ -60,7 +55,6 @@ toJulian date = (year, month, day)
 fromJulian :: Year -> MonthOfYear -> DayOfMonth -> Day
 fromJulian year month day = fromJulianYearAndDay year (monthAndDayToDayOfYear (isJulianLeapYear year) month day)
 
-#ifdef __GLASGOW_HASKELL__
 -- | Bidirectional abstract constructor for the proleptic Julian calendar.
 -- Invalid values will be clipped to the correct range, month first, then day.
 pattern JulianYearMonthDay :: Year -> MonthOfYear -> DayOfMonth -> Day
@@ -70,7 +64,6 @@ pattern JulianYearMonthDay y m d <-
         JulianYearMonthDay y m d = fromJulian y m d
 
 {-# COMPLETE JulianYearMonthDay #-}
-#endif
 
 -- | Convert from proleptic Julian calendar.
 -- Invalid values will return Nothing.

lib/Data/Time/Calendar/Month.hs

@@ -1,17 +1,14 @@
-{-# LANGUAGE CPP #-}
 {-# LANGUAGE Safe #-}
 
 -- | An absolute count of common calendar months.
 module Data.Time.Calendar.Month (
     Month (..),
     addMonths,
     diffMonths,
-#if __GLASGOW_HASKELL__
     pattern YearMonth,
     fromYearMonthValid,
     pattern MonthDay,
     fromMonthDayValid,
-#endif
 ) where
 
 import Control.DeepSeq
@@ -50,7 +47,6 @@ instance Ix Month where
     inRange (MkMonth a, MkMonth b) (MkMonth c) = inRange (a, b) c
     rangeSize (MkMonth a, MkMonth b) = rangeSize (a, b)
 
-#ifdef __GLASGOW_HASKELL__
 -- | Show as @yyyy-mm@.
 instance Show Month where
     show (YearMonth y m) = show4 y ++ "-" ++ show2 m
@@ -67,20 +63,18 @@ instance DayPeriod Month where
     periodFirstDay (YearMonth y m) = YearMonthDay y m 1
     periodLastDay (YearMonth y m) = YearMonthDay y m 31 -- clips to correct day
     dayPeriod (YearMonthDay y my _) = YearMonth y my
-#endif
 
 addMonths :: Integer -> Month -> Month
 addMonths n (MkMonth a) = MkMonth $ a + n
 
 diffMonths :: Month -> Month -> Integer
 diffMonths (MkMonth a) (MkMonth b) = a - b
 
-#ifdef __GLASGOW_HASKELL__
 -- | Bidirectional abstract constructor.
 -- Invalid months of year will be clipped to the correct range.
 pattern YearMonth :: Year -> MonthOfYear -> Month
 pattern YearMonth y my <-
-    MkMonth ((\m -> divMod' m 12) -> (y, succ . fromInteger -> my))
+    MkMonth ((\m -> divMod' m 12) -> (y, (succ . fromInteger -> my)))
     where
         YearMonth y my = MkMonth $ (y * 12) + toInteger (pred $ clip 1 12 my)
 
@@ -103,4 +97,3 @@ fromMonthDayValid :: Month -> DayOfMonth -> Maybe Day
 fromMonthDayValid = periodToDayValid
 
 {-# COMPLETE MonthDay #-}
-#endif

lib/Data/Time/Calendar/MonthDay.hs

@@ -1,9 +1,7 @@
-{-# LANGUAGE CPP #-}
 {-# LANGUAGE Safe #-}
 
 module Data.Time.Calendar.MonthDay (
     MonthOfYear,
-#ifdef __GLASGOW_HASKELL__
     pattern January,
     pattern February,
     pattern March,
@@ -16,7 +14,6 @@ module Data.Time.Calendar.MonthDay (
     pattern October,
     pattern November,
     pattern December,
-#endif
     DayOfMonth,
     DayOfYear,
     monthAndDayToDayOfYear,

lib/Data/Time/Calendar/OrdinalDate.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE CPP #-}
 {-# LANGUAGE Safe #-}
 
 -- | ISO 8601 Ordinal Date format
@@ -46,7 +45,6 @@ fromOrdinalDate year day = ModifiedJulianDay mjd
             + (div y 400)
             - 678576
 
-#ifdef __GLASGOW_HASKELL__
 -- | Bidirectional abstract constructor for ISO 8601 Ordinal Date format.
 -- Invalid day numbers will be clipped to the correct range (1 to 365 or 366).
 pattern YearDay :: Year -> DayOfYear -> Day
@@ -56,7 +54,6 @@ pattern YearDay y d <-
         YearDay y d = fromOrdinalDate y d
 
 {-# COMPLETE YearDay #-}
-#endif
 
 -- | Convert from ISO 8601 Ordinal Date format.
 -- Invalid day numbers return 'Nothing'

lib/Data/Time/Calendar/Quarter.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE CPP #-}
 {-# LANGUAGE Safe #-}
 
 -- | Year quarters.
@@ -7,18 +6,12 @@ module Data.Time.Calendar.Quarter (
     addQuarters,
     diffQuarters,
     Quarter (..),
-#ifdef __GLASGOW_HASKELL__
     pattern YearQuarter,
-#endif
     monthOfYearQuarter,
-#ifdef __GLASGOW_HASKELL__
     monthQuarter,
     dayQuarter,
-#endif
     DayOfQuarter,
-#ifdef __GLASGOW_HASKELL__
     pattern QuarterDay,
-#endif
 ) where
 
 import Control.DeepSeq
@@ -84,7 +77,6 @@ instance Ix Quarter where
     inRange (MkQuarter a, MkQuarter b) (MkQuarter c) = inRange (a, b) c
     rangeSize (MkQuarter a, MkQuarter b) = rangeSize (a, b)
 
-#ifdef __GLASGOW_HASKELL__
 -- | Show as @yyyy-Qn@.
 instance Show Quarter where
     show (YearQuarter y qy) = show4 y ++ "-" ++ show qy
@@ -111,24 +103,21 @@ instance DayPeriod Quarter where
             Q3 -> periodLastDay $ YearMonth y September
             Q4 -> periodLastDay $ YearMonth y December
     dayPeriod (MonthDay m _) = monthQuarter m
-#endif
 
 addQuarters :: Integer -> Quarter -> Quarter
 addQuarters n (MkQuarter a) = MkQuarter $ a + n
 
 diffQuarters :: Quarter -> Quarter -> Integer
 diffQuarters (MkQuarter a) (MkQuarter b) = a - b
 
-#ifdef __GLASGOW_HASKELL__
 -- | Bidirectional abstract constructor.
 pattern YearQuarter :: Year -> QuarterOfYear -> Quarter
 pattern YearQuarter y qy <-
-    MkQuarter ((\q -> divMod' q 4) -> (y, toEnum . succ . fromInteger -> qy))
+    MkQuarter ((\q -> divMod' q 4) -> (y, (toEnum . succ . fromInteger -> qy)))
     where
         YearQuarter y qy = MkQuarter $ (y * 4) + toInteger (pred $ fromEnum qy)
 
 {-# COMPLETE YearQuarter #-}
-#endif
 
 -- | The 'QuarterOfYear' this 'MonthOfYear' is in.
 monthOfYearQuarter :: MonthOfYear -> QuarterOfYear
@@ -137,7 +126,6 @@ monthOfYearQuarter my | my <= 6 = Q2
 monthOfYearQuarter my | my <= 9 = Q3
 monthOfYearQuarter _ = Q4
 
-#ifdef __GLASGOW_HASKELL__
 -- | The 'Quarter' this 'Month' is in.
 monthQuarter :: Month -> Quarter
 monthQuarter (YearMonth y my) = YearQuarter y $ monthOfYearQuarter my
@@ -157,4 +145,3 @@ pattern QuarterDay q dq <-
         QuarterDay = periodToDay
 
 {-# COMPLETE QuarterDay #-}
-#endif

lib/Data/Time/Calendar/Types.hs

@@ -1,12 +1,10 @@
-{-# LANGUAGE CPP #-}
 {-# LANGUAGE Safe #-}
 
 module Data.Time.Calendar.Types where
 
 -- | Year of Common Era (when positive).
 type Year = Integer
 
-#ifdef __GLASGOW_HASKELL__
 -- | Also known as Anno Domini.
 pattern CommonEra :: Integer -> Year
 pattern CommonEra n <-
@@ -24,12 +22,10 @@ pattern BeforeCommonEra n <-
         BeforeCommonEra n = 1 - n
 
 {-# COMPLETE CommonEra, BeforeCommonEra #-}
-#endif
 
 -- | Month of year, in range 1 (January) to 12 (December).
 type MonthOfYear = Int
 
-#ifdef __GLASGOW_HASKELL__
 pattern January :: MonthOfYear
 pattern January = 1
 
@@ -68,7 +64,6 @@ pattern December :: MonthOfYear
 pattern December = 12
 
 {-# COMPLETE January, February, March, April, May, June, July, August, September, October, November, December #-}
-#endif
 
 -- | Day of month, in range 1 to 31.
 type DayOfMonth = Int

lib/Data/Time/Calendar/WeekDate.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE CPP #-}
 {-# LANGUAGE Safe #-}
 
 -- | Week-based calendars
@@ -15,9 +14,7 @@ module Data.Time.Calendar.WeekDate (
     -- * ISO 8601 Week Date format
     toWeekDate,
     fromWeekDate,
-#ifdef __GLASGOW_HASKELL__
     pattern YearWeekDay,
-#endif
     fromWeekDateValid,
     showWeekDate,
 ) where
@@ -26,20 +23,14 @@ import Data.Time.Calendar.Days
 import Data.Time.Calendar.OrdinalDate
 import Data.Time.Calendar.Private
 import Data.Time.Calendar.Week
-#ifdef __GLASGOW_HASKELL__
 import qualified Language.Haskell.TH.Syntax as TH
-#endif
 
 data FirstWeekType
     = -- | first week is the first whole week of the year
       FirstWholeWeek
     | -- | first week is the first week with four days in the year
       FirstMostWeek
-    deriving (Eq
-#ifdef __GLASGOW_HASKELL__
-                , TH.Lift
-#endif
-                         )
+    deriving (Eq, TH.Lift)
 
 firstDayOfWeekCalendar :: FirstWeekType -> DayOfWeek -> Year -> Day
 firstDayOfWeekCalendar wt dow year =
@@ -129,17 +120,15 @@ toWeekDate d =
 fromWeekDate :: Year -> WeekOfYear -> Int -> Day
 fromWeekDate y wy dw = fromWeekCalendar FirstMostWeek Monday y wy (toEnum $ clip 1 7 dw)
 
-#ifdef __GLASGOW_HASKELL__
 -- | Bidirectional abstract constructor for ISO 8601 Week Date format.
 -- Invalid week values will be clipped to the correct range.
 pattern YearWeekDay :: Year -> WeekOfYear -> DayOfWeek -> Day
 pattern YearWeekDay y wy dw <-
-    (toWeekDate -> (y, wy, toEnum -> dw))
+    (toWeekDate -> (y, wy, (toEnum -> dw)))
     where
         YearWeekDay y wy dw = fromWeekDate y wy (fromEnum dw)
 
 {-# COMPLETE YearWeekDay #-}
-#endif
 
 -- | Convert from ISO 8601 Week Date format. First argument is year, second week number (1-52 or 53), third day of week (1 for Monday to 7 for Sunday).
 -- Invalid week and day values will return Nothing.

lib/Data/Time/Clock/Internal/AbsoluteTime.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE CPP #-}
 {-# LANGUAGE Safe #-}
 
 -- | TAI and leap-second maps for converting to UTC: most people won't need this module.
@@ -15,18 +14,12 @@ import Control.DeepSeq
 import Data.Data
 import Data.Time.Calendar.Days
 import Data.Time.Clock.Internal.DiffTime
-#ifdef __GLASGOW_HASKELL__
 import qualified Language.Haskell.TH.Syntax as TH
-#endif
 
 -- | AbsoluteTime is TAI, time as measured by a clock.
 newtype AbsoluteTime
     = MkAbsoluteTime DiffTime
-    deriving (Eq, Ord, Data, Typeable
-#ifdef __GLASGOW_HASKELL__
-                                     , TH.Lift
-#endif
-                                              )
+    deriving (Eq, Ord, Data, Typeable, TH.Lift)
 
 instance NFData AbsoluteTime where
     rnf (MkAbsoluteTime a) = rnf a