Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Make it compile with MicroHs #262

Merged
merged 11 commits into from
Nov 17, 2024
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension


Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
46 changes: 46 additions & 0 deletions .github/workflows/ci.mhs.yml
Original file line number Diff line number Diff line change
@@ -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
5 changes: 5 additions & 0 deletions lib/Data/Time/Calendar/CalendarDiffDays.hs
Original file line number Diff line number Diff line change
@@ -1,3 +1,4 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE Safe #-}

module Data.Time.Calendar.CalendarDiffDays (
Expand All @@ -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
Expand All @@ -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
Expand Down
9 changes: 8 additions & 1 deletion lib/Data/Time/Calendar/Days.hs
Original file line number Diff line number Diff line change
@@ -1,3 +1,4 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE Safe #-}

module Data.Time.Calendar.Days (
Expand All @@ -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
Expand Down
11 changes: 11 additions & 0 deletions lib/Data/Time/Calendar/Gregorian.hs
Original file line number Diff line number Diff line change
@@ -1,3 +1,4 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE TypeSynonymInstances #-}

Expand All @@ -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,
Expand All @@ -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,
Expand Down Expand Up @@ -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 #-}

Expand Down Expand Up @@ -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
7 changes: 7 additions & 0 deletions lib/Data/Time/Calendar/Julian.hs
Original file line number Diff line number Diff line change
@@ -1,8 +1,10 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE Safe #-}

module Data.Time.Calendar.Julian (
Year,
MonthOfYear,
#ifdef __GLASGOW_HASKELL__
pattern January,
pattern February,
pattern March,
Expand All @@ -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,
Expand Down Expand Up @@ -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
Expand All @@ -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.
Expand Down
15 changes: 14 additions & 1 deletion lib/Data/Time/Calendar/Month.hs
Original file line number Diff line number Diff line change
@@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -97,3 +109,4 @@ fromMonthDayValid :: Month -> DayOfMonth -> Maybe Day
fromMonthDayValid = periodToDayValid

{-# COMPLETE MonthDay #-}
#endif
3 changes: 3 additions & 0 deletions lib/Data/Time/Calendar/MonthDay.hs
Original file line number Diff line number Diff line change
@@ -1,7 +1,9 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE Safe #-}

module Data.Time.Calendar.MonthDay (
MonthOfYear,
#ifdef __GLASGOW_HASKELL__
pattern January,
pattern February,
pattern March,
Expand All @@ -14,6 +16,7 @@ module Data.Time.Calendar.MonthDay (
pattern October,
pattern November,
pattern December,
#endif
DayOfMonth,
DayOfYear,
monthAndDayToDayOfYear,
Expand Down
3 changes: 3 additions & 0 deletions lib/Data/Time/Calendar/OrdinalDate.hs
Original file line number Diff line number Diff line change
@@ -1,3 +1,4 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE Safe #-}

-- | ISO 8601 Ordinal Date format
Expand Down Expand Up @@ -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
Expand All @@ -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'
Expand Down
Loading