Merge pull request #262 from augustss/master

Make it compile with MicroHs

.github/workflows/ci.mhs.yml

@@ -0,0 +1,46 @@
+name: ci-mhs
+
+on:
+  push:
+    branches: [ "master" ]
+  pull_request:
+    branches: [ "master" ]
+
+jobs:
+  build-mhs-time:
+    runs-on: ubuntu-latest
+    steps:
+    - name: checkout time repo
+      uses: actions/checkout@v4
+      with:
+        path: time
+    - name: checkout mhs repo
+      uses: actions/checkout@v4
+      with:
+        repository: augustss/MicroHs
+        ref: stable-2
+        path: mhs
+    - name: make and install mhs
+      run: |
+        cd mhs
+        make minstall
+    - name: compile and install time package
+      run: |
+        PATH="$HOME/.mcabal/bin:$PATH"
+        cd time
+        mcabal install
+    - name: run ShowDefaultTZAbbreviations test
+      run: |
+        PATH="$HOME/.mcabal/bin:$PATH"
+        cd time
+        mhs test/ShowDefaultTZAbbreviations.hs -oShowDefaultTZAbbreviations
+        ./ShowDefaultTZAbbreviations
+    - name: run ShowTime test
+      run: |
+        PATH="$HOME/.mcabal/bin:$PATH"
+        cd time
+        mhs test/ShowTime.hs -oShowTime
+        ./ShowTime
+    - name: cleanup
+      run: |
+        rm -rf $HOME/.cabal

lib/Data/Time/Calendar/CalendarDiffDays.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE Safe #-}
 
 module Data.Time.Calendar.CalendarDiffDays (
@@ -7,8 +8,10 @@ module Data.Time.Calendar.CalendarDiffDays (
 
 import Control.DeepSeq
 import Data.Data
+#ifdef __GLASGOW_HASKELL__
 import GHC.Generics
 import qualified Language.Haskell.TH.Syntax as TH
+#endif
 
 data CalendarDiffDays = CalendarDiffDays
     { cdMonths :: Integer
@@ -20,10 +23,12 @@ data CalendarDiffDays = CalendarDiffDays
           Data
         , -- | @since 1.9.2
           Typeable
+#ifdef __GLASGOW_HASKELL__
         , -- | @since 1.14
           TH.Lift
         , -- | @since 1.14
           Generic
+#endif
         )
 
 instance NFData CalendarDiffDays where

lib/Data/Time/Calendar/Days.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE Safe #-}
 
 module Data.Time.Calendar.Days (
@@ -18,14 +19,20 @@ module Data.Time.Calendar.Days (
 import Control.DeepSeq
 import Data.Data
 import Data.Ix
+#ifdef __GLASGOW_HASKELL__
 import GHC.Generics
 import qualified Language.Haskell.TH.Syntax as TH
+#endif
 
 -- | The Modified Julian Day is a standard count of days, with zero being the day 1858-11-17.
 newtype Day = ModifiedJulianDay
     { toModifiedJulianDay :: Integer
     }
-    deriving (Eq, Ord, Data, Typeable, TH.Lift, Generic)
+    deriving (Eq, Ord, Data, Typeable
+#ifdef __GLASGOW_HASKELL__
+             , TH.Lift, Generic
+#endif
+             )
 
 instance NFData Day where
     rnf (ModifiedJulianDay a) = rnf a

lib/Data/Time/Calendar/Gregorian.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE Safe #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 
@@ -6,9 +7,12 @@
 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,
@@ -21,12 +25,15 @@ 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,
@@ -63,13 +70,15 @@ 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 #-}
 
@@ -184,8 +193,10 @@ 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,8 +1,10 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE Safe #-}
 
 module Data.Time.Calendar.Julian (
     Year,
     MonthOfYear,
+#ifdef __GLASGOW_HASKELL__
     pattern January,
     pattern February,
     pattern March,
@@ -15,12 +17,15 @@ 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,
@@ -55,6 +60,7 @@ 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
@@ -64,6 +70,7 @@ 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,14 +1,17 @@
+{-# 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
@@ -18,14 +21,20 @@ import Data.Ix
 import Data.Time.Calendar.Days
 import Data.Time.Calendar.Gregorian
 import Data.Time.Calendar.Private
+#if __GLASGOW_HASKELL__
 import GHC.Generics
 import qualified Language.Haskell.TH.Syntax as TH
+#endif
 import Text.ParserCombinators.ReadP
 import Text.Read
 
 -- | An absolute count of common calendar months.
 -- Number is equal to @(year * 12) + (monthOfYear - 1)@.
-newtype Month = MkMonth Integer deriving (Eq, Ord, Data, Typeable, TH.Lift, Generic)
+newtype Month = MkMonth Integer deriving (Eq, Ord, Data, Typeable
+#if __GLASGOW_HASKELL__
+                                                                 , TH.Lift, Generic
+#endif
+                                                                                   )
 
 instance NFData Month where
     rnf (MkMonth m) = rnf m
@@ -47,6 +56,7 @@ 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
@@ -63,13 +73,15 @@ 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
@@ -97,3 +109,4 @@ fromMonthDayValid :: Month -> DayOfMonth -> Maybe Day
 fromMonthDayValid = periodToDayValid
 
 {-# COMPLETE MonthDay #-}
+#endif

lib/Data/Time/Calendar/MonthDay.hs

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

lib/Data/Time/Calendar/OrdinalDate.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE Safe #-}
 
 -- | ISO 8601 Ordinal Date format
@@ -45,6 +46,7 @@ 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
@@ -54,6 +56,7 @@ 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'