From d89cc23baaf554d04f4d5521cd3a964e077f0380 Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Mon, 13 Mar 2017 20:38:39 +0000 Subject: [PATCH] Use common types for date/time (#76) * Use common types for date/time * Restore `T` in DateTime pretty printing --- bower.json | 21 +- src/Text/Markdown/SlamDown/Parser/Inline.purs | 39 ++- src/Text/Markdown/SlamDown/Pretty.purs | 32 ++- src/Text/Markdown/SlamDown/Syntax/Inline.purs | 3 +- .../Markdown/SlamDown/Syntax/TextBox.purs | 262 +++--------------- test/src/Test/Main.purs | 34 ++- 6 files changed, 115 insertions(+), 276 deletions(-) diff --git a/bower.json b/bower.json index e162492..af116bd 100644 --- a/bower.json +++ b/bower.json @@ -23,15 +23,16 @@ ], "dependencies": { "purescript-const": "^2.0.0", - "purescript-functors": "^1.0.0", - "purescript-lists": "^3.2.0", - "purescript-parsing": "^3.0.0", - "purescript-partial": "^1.1.2", - "purescript-precise": "^1.0.0", - "purescript-prelude": "^2.1.0", - "purescript-sets": "^2.0.0", - "purescript-strings": "^2.0.2", - "purescript-strongcheck": "^2.0.0", - "purescript-validation": "^2.0.0" + "purescript-functors": "^1.1.0", + "purescript-lists": "^3.4.0", + "purescript-parsing": "^3.2.1", + "purescript-partial": "^1.2.0", + "purescript-precise": "^1.1.0", + "purescript-prelude": "^2.5.0", + "purescript-sets": "^2.0.1", + "purescript-strings": "^2.1.0", + "purescript-strongcheck": "^2.1.0", + "purescript-validation": "^2.0.0", + "purescript-datetime": "^2.2.0" } } diff --git a/src/Text/Markdown/SlamDown/Parser/Inline.purs b/src/Text/Markdown/SlamDown/Parser/Inline.purs index ecf8a11..fcc870d 100644 --- a/src/Text/Markdown/SlamDown/Parser/Inline.purs +++ b/src/Text/Markdown/SlamDown/Parser/Inline.purs @@ -13,7 +13,9 @@ import Control.Lazy as Lazy import Data.Array as A import Data.Bifunctor (lmap) import Data.Const (Const(..)) +import Data.DateTime as DT import Data.Either (Either(..)) +import Data.Enum (toEnum) import Data.Foldable (elem) import Data.Functor.Compose (Compose(..)) import Data.HugeNum as HN @@ -291,19 +293,19 @@ inlines = L.many inline2 <* PS.eof M.Nothing → pure $ Left case template of SD.DateTime SD.Minutes _ → - "Incorrect datetime default value, please use \"YYYY-MM-DD HH:mm\" or \"YYYY-MM-DDTHH:mm\" format" + "Invalid datetime default value, please use \"YYYY-MM-DD HH:mm\" format" SD.DateTime SD.Seconds _ → - "Incorrect datetime default value, please use \"YYYY-MM-DD HH:mm:ss\" or \"YYYY-MM-DDTHH:mm:ss\" format" + "Invalid datetime default value, please use \"YYYY-MM-DD HH:mm:ss\" format" SD.Date _ → - "Incorrect date default value, please use \"YYYY-MM-DD\" format" + "Invalid date default value, please use \"YYYY-MM-DD\" format" SD.Time SD.Minutes _ → - "Incorrect time default value, please use \"HH:mm\" format" + "Invalid time default value, please use \"HH:mm\" format" SD.Time SD.Seconds _ → - "Incorrect time default value, please use \"HH:mm:ss\" format" + "Invalid time default value, please use \"HH:mm:ss\" format" SD.Numeric _ → - "Incorrect numeric default value" + "Invalid numeric default value" SD.PlainText _ → - "Incorrect default value" + "Invalid default value" parseTextBoxTemplate ∷ P.Parser String (SD.TextBox (Const Unit)) parseTextBoxTemplate = @@ -419,28 +421,33 @@ parseTextBox isPlainText eta template = SD.PlainText _ → SD.PlainText <$> eta parsePlainTextValue where + parseDateTimeValue ∷ SD.TimePrecision → P.Parser String DT.DateTime parseDateTimeValue prec = do date ← parseDateValue (PC.try $ void $ PS.string "T") <|> PU.skipSpaces time ← parseTimeValue prec - pure { date, time } + pure $ DT.DateTime date time + parseDateValue ∷ P.Parser String DT.Date parseDateValue = do year ← parseYear PU.skipSpaces *> dash *> PU.skipSpaces month ← natural - when (month > 12) $ P.fail "Incorrect month" + when (month > 12) $ P.fail "Invalid month" PU.skipSpaces *> dash *> PU.skipSpaces day ← natural - when (day > 31) $ P.fail "Incorrect day" - pure { month, day, year } + when (day > 31) $ P.fail "Invalid day" + case DT.canonicalDate <$> toEnum year <*> toEnum month <*> toEnum day of + M.Nothing → P.fail "Invalid date" + M.Just dt → pure dt + parseTimeValue ∷ SD.TimePrecision → P.Parser String DT.Time parseTimeValue prec = do hours ← natural - when (hours > 23) $ P.fail "Incorrect hours" + when (hours > 23) $ P.fail "Invalid hours" PU.skipSpaces *> colon *> PU.skipSpaces minutes ← natural - when (minutes > 59) $ P.fail "Incorrect minutes" + when (minutes > 59) $ P.fail "Invalid minutes" seconds ← case prec of SD.Minutes -> do scolon ← PC.try $ PC.optionMaybe $ PU.skipSpaces *> colon @@ -449,7 +456,7 @@ parseTextBox isPlainText eta template = SD.Seconds -> do PU.skipSpaces *> colon *> PU.skipSpaces secs ← natural - when (secs > 59) $ P.fail "Incorrect seconds" + when (secs > 59) $ P.fail "Invalid seconds" PU.skipSpaces pure $ M.Just secs PU.skipSpaces @@ -466,7 +473,9 @@ parseTextBox isPlainText eta template = else if isAM && hours == 12 then 0 else hours - pure { hours : hours', minutes, seconds } + case DT.Time <$> toEnum hours' <*> toEnum minutes <*> toEnum (M.fromMaybe 0 seconds) <*> pure bottom of + M.Nothing → P.fail "Invalid time" + M.Just t → pure t parseNumericValue = do sign ← PC.try (-1 <$ PS.char '-') <|> pure 1 diff --git a/src/Text/Markdown/SlamDown/Pretty.purs b/src/Text/Markdown/SlamDown/Pretty.purs index 481fa6e..a295a54 100644 --- a/src/Text/Markdown/SlamDown/Pretty.purs +++ b/src/Text/Markdown/SlamDown/Pretty.purs @@ -6,15 +6,17 @@ module Text.Markdown.SlamDown.Pretty import Prelude import Data.Array as A +import Data.DateTime as DT import Data.Foldable (fold, elem) import Data.Functor.Compose (Compose) import Data.HugeNum as HN import Data.Identity (Identity(..)) import Data.List as L import Data.Maybe as M +import Data.Enum (fromEnum) import Data.Monoid (mempty) -import Data.String as S import Data.Newtype (unwrap) +import Data.String as S import Data.Unfoldable as U import Text.Markdown.SlamDown.Syntax as SD @@ -121,28 +123,28 @@ prettyPrintTextBoxValue t = SD.Time prec (Identity def) → prettyPrintTime prec def SD.DateTime prec (Identity def) → prettyPrintDateTime prec def -prettyPrintDate ∷ SD.DateValue → String -prettyPrintDate { day, month, year } = - printIntPadded 4 year +prettyPrintDate ∷ DT.Date → String +prettyPrintDate d = + printIntPadded 4 (fromEnum $ DT.year d) <> "-" - <> printIntPadded 2 month + <> printIntPadded 2 (fromEnum $ DT.month d) <> "-" - <> printIntPadded 2 day + <> printIntPadded 2 (fromEnum $ DT.day d) -prettyPrintTime ∷ SD.TimePrecision → SD.TimeValue → String -prettyPrintTime prec { hours, minutes, seconds }= - printIntPadded 2 hours +prettyPrintTime ∷ SD.TimePrecision → DT.Time → String +prettyPrintTime prec t = + printIntPadded 2 (fromEnum $ DT.hour t) <> ":" - <> printIntPadded 2 minutes + <> printIntPadded 2 (fromEnum $ DT.minute t) <> case prec of - SD.Seconds -> ":" <> printIntPadded 2 (M.fromMaybe 0 seconds) + SD.Seconds -> ":" <> printIntPadded 2 (fromEnum $ DT.second t) _ -> "" -prettyPrintDateTime ∷ SD.TimePrecision → SD.DateTimeValue → String -prettyPrintDateTime prec { date, time } = - prettyPrintDate date +prettyPrintDateTime ∷ SD.TimePrecision → DT.DateTime → String +prettyPrintDateTime prec dt = + prettyPrintDate (DT.date dt) <> "T" - <> prettyPrintTime prec time + <> prettyPrintTime prec (DT.time dt) printIntPadded ∷ Int → Int → String printIntPadded l i = diff --git a/src/Text/Markdown/SlamDown/Syntax/Inline.purs b/src/Text/Markdown/SlamDown/Syntax/Inline.purs index c1e734e..0b9c986 100644 --- a/src/Text/Markdown/SlamDown/Syntax/Inline.purs +++ b/src/Text/Markdown/SlamDown/Syntax/Inline.purs @@ -55,7 +55,7 @@ instance showInline ∷ (Show a) ⇒ Show (Inline a) where show (FormField l r f) = "(FormField " <> show l <> " " <> show r <> " " <> show f <> ")" derive instance eqInline ∷ (Eq a, Ord a) ⇒ Eq (Inline a) -derive instance ordInline ∷ (Ord a) ⇒ Ord (Inline a) +derive instance ordInline ∷ Ord a ⇒ Ord (Inline a) -- | Nota bene: this does not generate any recursive structure instance arbitraryInline ∷ (SCA.Arbitrary a, Eq a) ⇒ SCA.Arbitrary (Inline a) where @@ -74,7 +74,6 @@ instance arbitraryInline ∷ (SCA.Arbitrary a, Eq a) ⇒ SCA.Arbitrary (Inline a 9 → Link L.Nil <$> SCA.arbitrary _ → Image L.Nil <$> SCA.arbitrary - data LinkTarget = InlineLink String | ReferenceLink (M.Maybe String) diff --git a/src/Text/Markdown/SlamDown/Syntax/TextBox.purs b/src/Text/Markdown/SlamDown/Syntax/TextBox.purs index da18d33..c5688e4 100644 --- a/src/Text/Markdown/SlamDown/Syntax/TextBox.purs +++ b/src/Text/Markdown/SlamDown/Syntax/TextBox.purs @@ -1,174 +1,29 @@ module Text.Markdown.SlamDown.Syntax.TextBox - ( TimeValue - , DateValue - , DateTimeValue - , TimePrecision(..) + ( TimePrecision(..) , TextBox(..) , transTextBox , traverseTextBox - - , TimeValueP - , DateValueP - , DateTimeValueP ) where import Prelude -import Data.Function (on) +import Data.DateTime as DT import Data.HugeNum as HN import Data.Identity (Identity(..)) -import Data.Maybe (Maybe(..)) import Data.Newtype (unwrap) import Test.StrongCheck.Arbitrary as SCA +import Test.StrongCheck.Data.ArbDateTime as ADT import Test.StrongCheck.Gen as Gen -type TimeValue = - { hours ∷ Int - , minutes ∷ Int - , seconds ∷ Maybe Int - } - -newtype TimeValueP = TimeValueP TimeValue - -getTimeValueP - ∷ TimeValueP - → TimeValue -getTimeValueP (TimeValueP v) = - v - -instance eqTimeValueP ∷ Eq TimeValueP where - eq (TimeValueP v1) (TimeValueP v2) = - v1.hours == v2.hours - && v1.minutes == v2.minutes - -instance ordTimeValueP ∷ Ord TimeValueP where - compare (TimeValueP v1) (TimeValueP v2) = - compare v1.hours v2.hours - <> compare v1.minutes v2.minutes - -instance showTimeValueP ∷ Show TimeValueP where - show (TimeValueP { hours, minutes }) = - "{ hours : " - <> show hours - <> ", minutes : " - <> show minutes - <> " }" - -instance arbitraryTimeValueP ∷ SCA.Arbitrary TimeValueP where - arbitrary = do - hours ← Gen.chooseInt 0 12 - minutes ← Gen.chooseInt 0 60 - secs ← Gen.chooseInt 0 60 - b <- (_ < 0.5) <$> Gen.choose 0.0 1.0 - let seconds = if b then Nothing else Just secs - pure $ TimeValueP { hours , minutes , seconds } - -instance coarbitraryTimeValueP :: SCA.Coarbitrary TimeValueP where - coarbitrary (TimeValueP { hours, minutes, seconds }) gen = do - SCA.coarbitrary hours gen - SCA.coarbitrary minutes gen - SCA.coarbitrary seconds gen - -type DateValue = - { month ∷ Int - , day ∷ Int - , year ∷ Int - } - -newtype DateValueP = DateValueP DateValue - -getDateValueP - ∷ DateValueP - → DateValue -getDateValueP (DateValueP v) = - v - -instance eqDateValueP ∷ Eq DateValueP where - eq (DateValueP v1) (DateValueP v2) = - v1.month == v2.month - && v1.day == v2.day - && v1.year == v2.year - -instance ordDateValueP ∷ Ord DateValueP where - compare (DateValueP v1) (DateValueP v2) = - compare v1.year v2.year - <> compare v1.month v2.month - <> compare v1.day v2.day - -instance showDateValueP ∷ Show DateValueP where - show (DateValueP { month, day, year }) = - "{ month : " - <> show month - <> ", day : " - <> show day - <> ", year : " - <> show year - <> " }" - -instance arbitraryDateValueP ∷ SCA.Arbitrary DateValueP where - arbitrary = do - month ← Gen.chooseInt 0 12 - day ← Gen.chooseInt 0 30 - year ← Gen.chooseInt 0 3000 - pure $ DateValueP { month , day, year } - -instance coarbitraryDateValueP :: SCA.Coarbitrary DateValueP where - coarbitrary (DateValueP { month, day, year }) gen = do - SCA.coarbitrary month gen - SCA.coarbitrary day gen - SCA.coarbitrary year gen - -type DateTimeValue = - { date ∷ DateValue - , time ∷ TimeValue - } - -newtype DateTimeValueP = DateTimeValueP DateTimeValue - -getDateTimeValueP - ∷ DateTimeValueP - → DateTimeValue -getDateTimeValueP (DateTimeValueP v) = - v - -instance eqDateTimeValueP ∷ Eq DateTimeValueP where - eq (DateTimeValueP v1) (DateTimeValueP v2) = - on eq (DateValueP <<< _.date) v1 v2 - && on eq (TimeValueP <<< _.time) v1 v2 - -instance ordDateTimeValueP ∷ Ord DateTimeValueP where - compare (DateTimeValueP v1) (DateTimeValueP v2) = - on compare (DateValueP <<< _.date) v1 v2 - <> on compare (TimeValueP <<< _.time) v1 v2 - -instance showDateTimeValueP ∷ Show DateTimeValueP where - show (DateTimeValueP { date, time }) = - "{ date : " - <> show (DateValueP date) - <> ", time : " - <> show (TimeValueP time) - <> " }" - -instance arbitraryDateTimeValueP ∷ SCA.Arbitrary DateTimeValueP where - arbitrary = do - DateValueP date ← SCA.arbitrary - TimeValueP time ← SCA.arbitrary - pure $ DateTimeValueP { date, time } - -instance coarbitraryDateTimeValueP :: SCA.Coarbitrary DateTimeValueP where - coarbitrary (DateTimeValueP { date, time }) gen = do - SCA.coarbitrary (DateValueP date) gen - SCA.coarbitrary (TimeValueP time) gen - data TimePrecision = Minutes | Seconds -derive instance eqTimePrecision :: Eq TimePrecision -derive instance ordTimePrecision :: Ord TimePrecision +derive instance eqTimePrecision ∷ Eq TimePrecision +derive instance ordTimePrecision ∷ Ord TimePrecision -instance showTimePrecision :: Show TimePrecision where +instance showTimePrecision ∷ Show TimePrecision where show Minutes = "Minutes" show Seconds = "Seconds" @@ -178,100 +33,67 @@ instance arbitraryTimePrecision ∷ SCA.Arbitrary TimePrecision where 0 → Minutes _ → Seconds -instance coarbitraryTimePrecision :: SCA.Coarbitrary TimePrecision where +instance coarbitraryTimePrecision ∷ SCA.Coarbitrary TimePrecision where coarbitrary Minutes = SCA.coarbitrary 1 coarbitrary Seconds = SCA.coarbitrary 2 data TextBox f = PlainText (f String) | Numeric (f HN.HugeNum) - | Date (f DateValue) - | Time TimePrecision (f TimeValue) - | DateTime TimePrecision (f DateTimeValue) + | Date (f DT.Date) + | Time TimePrecision (f DT.Time) + | DateTime TimePrecision (f DT.DateTime) -transTextBox - ∷ ∀ f g - . (f ~> g) - → TextBox f - → TextBox g -transTextBox eta = - unwrap <<< - traverseTextBox (eta >>> Identity) +transTextBox ∷ ∀ f g. (f ~> g) → TextBox f → TextBox g +transTextBox eta = unwrap <<< traverseTextBox (Identity <<< eta) traverseTextBox ∷ ∀ f g h - . (Applicative h) + . Applicative h ⇒ (∀ a. f a → h (g a)) → TextBox f → h (TextBox g) -traverseTextBox eta t = - case t of - PlainText def → PlainText <$> eta def - Numeric def → Numeric <$> eta def - Date def → Date <$> eta def - Time prec def → Time prec <$> eta def - DateTime prec def → DateTime prec <$> eta def - -instance showTextBox ∷ (Functor f, Show (f String), Show (f HN.HugeNum), Show (f TimeValueP), Show (f DateValueP), Show (f DateTimeValueP)) ⇒ Show (TextBox f) where - show = - case _ of - PlainText def → "(PlainText " <> show def <> ")" - Numeric def → "(Numeric " <> show def <> ")" - Date def → "(Date " <> show (DateValueP <$> def) <> ")" - Time prec def → "(Time " <> show prec <> " " <> show (TimeValueP <$> def) <> ")" - DateTime prec def → "(DateTime " <> show prec <> " " <> show (DateTimeValueP <$> def) <> ")" - -instance ordTextBox ∷ (Functor f, Ord (f String), Ord (f HN.HugeNum), Ord (f TimeValueP), Ord (f DateValueP), Ord (f DateTimeValueP)) ⇒ Ord (TextBox f) where - compare = - case _, _ of - PlainText d1, PlainText d2 → compare d1 d2 - PlainText _, _ → LT - _, PlainText _ → GT - - Numeric d1, Numeric d2 → compare d1 d2 - Numeric _, _ → LT - _, Numeric _ → GT - - Date d1, Date d2 → on compare (map DateValueP) d1 d2 - Date _, _ → LT - _, Date _ → GT - - Time prec1 t1, Time prec2 t2 → compare prec1 prec2 <> on compare (map TimeValueP) t1 t2 - Time _ _, _ → LT - _, Time _ _ → GT - - DateTime prec1 d1, DateTime prec2 d2 → compare prec1 prec2 <> on compare (map DateTimeValueP) d1 d2 - -instance eqTextBox ∷ (Functor f, Eq (f String), Eq (f HN.HugeNum), Eq (f TimeValueP), Eq (f DateValueP), Eq (f DateTimeValueP)) ⇒ Eq (TextBox f) where - eq = - case _, _ of - PlainText d1, PlainText d2 → d1 == d2 - Numeric d1, Numeric d2 → d1 == d2 - Date d1, Date d2 → on eq (map DateValueP) d1 d2 - Time prec1 d1, Time prec2 d2 → prec1 == prec2 && on eq (map TimeValueP) d1 d2 - DateTime prec1 d1, DateTime prec2 d2 → prec1 == prec2 && on eq (map DateTimeValueP) d1 d2 - _, _ → false - -instance arbitraryTextBox ∷ (Functor f, SCA.Arbitrary (f String), SCA.Arbitrary (f Number), SCA.Arbitrary (f TimeValueP), SCA.Arbitrary (f DateValueP), SCA.Arbitrary (f DateTimeValueP)) ⇒ SCA.Arbitrary (TextBox f) where +traverseTextBox eta = case _ of + PlainText def → PlainText <$> eta def + Numeric def → Numeric <$> eta def + Date def → Date <$> eta def + Time prec def → Time prec <$> eta def + DateTime prec def → DateTime prec <$> eta def + +instance showTextBox ∷ (Functor f, Show (f String), Show (f HN.HugeNum), Show (f DT.Time), Show (f DT.Date), Show (f DT.DateTime)) ⇒ Show (TextBox f) where + show = case _ of + PlainText def → "(PlainText " <> show def <> ")" + Numeric def → "(Numeric " <> show def <> ")" + Date def → "(Date " <> show def <> ")" + Time prec def → "(Time " <> show prec <> " " <> show def <> ")" + DateTime prec def → "(DateTime " <> show prec <> " " <> show def <> ")" + +derive instance eqTextBox ∷ (Functor f, Eq (f String), Eq (f HN.HugeNum), Eq (f DT.Time), Eq (f DT.Date), Eq (f DT.DateTime)) ⇒ Eq (TextBox f) +derive instance ordTextBox ∷ (Functor f, Ord (f String), Ord (f HN.HugeNum), Ord (f DT.Time), Ord (f DT.Date), Ord (f DT.DateTime)) ⇒ Ord (TextBox f) + +instance arbitraryTextBox ∷ (Functor f, SCA.Arbitrary (f String), SCA.Arbitrary (f Number), SCA.Arbitrary (f ADT.ArbTime), SCA.Arbitrary (f ADT.ArbDate), SCA.Arbitrary (f ADT.ArbDateTime)) ⇒ SCA.Arbitrary (TextBox f) where arbitrary = do i ← Gen.chooseInt 0 5 case i of 0 → PlainText <$> SCA.arbitrary 1 → Numeric <<< map HN.fromNumber <$> SCA.arbitrary - 2 → Date <<< map getDateValueP <$> SCA.arbitrary - 3 → Time <$> SCA.arbitrary <*> (map getTimeValueP <$> SCA.arbitrary) - 4 → DateTime <$> SCA.arbitrary <*> (map getDateTimeValueP <$> SCA.arbitrary) + 2 → Date <<< map ADT.runArbDate <$> SCA.arbitrary + 3 → Time <$> SCA.arbitrary <*> (map (eraseMillis <<< ADT.runArbTime) <$> SCA.arbitrary) + 4 → DateTime <$> SCA.arbitrary <*> (map (DT.modifyTime eraseMillis <<< ADT.runArbDateTime) <$> SCA.arbitrary) _ → PlainText <$> SCA.arbitrary -instance coarbitraryTextBox :: (Functor f, SCA.Coarbitrary (f String), SCA.Coarbitrary (f Number), SCA.Coarbitrary (f DateValueP), SCA.Coarbitrary (f TimeValueP), SCA.Coarbitrary (f DateTimeValueP)) ⇒ SCA.Coarbitrary (TextBox f) where +instance coarbitraryTextBox ∷ (Functor f, SCA.Coarbitrary (f String), SCA.Coarbitrary (f Number), SCA.Coarbitrary (f ADT.ArbDate), SCA.Coarbitrary (f ADT.ArbTime), SCA.Coarbitrary (f ADT.ArbDateTime)) ⇒ SCA.Coarbitrary (TextBox f) where coarbitrary = case _ of PlainText d -> SCA.coarbitrary d Numeric d -> SCA.coarbitrary $ HN.toNumber <$> d - Date d -> SCA.coarbitrary $ DateValueP <$> d + Date d -> SCA.coarbitrary (ADT.ArbDate <$> d) Time prec d -> do SCA.coarbitrary prec - SCA.coarbitrary $ TimeValueP <$> d + SCA.coarbitrary (ADT.ArbTime <$> d) DateTime prec d -> do SCA.coarbitrary prec - SCA.coarbitrary $ DateTimeValueP <$> d + SCA.coarbitrary (ADT.ArbDateTime <$> d) + +eraseMillis ∷ DT.Time → DT.Time +eraseMillis (DT.Time h m s _) = DT.Time h m s bottom diff --git a/test/src/Test/Main.purs b/test/src/Test/Main.purs index e6e6c1d..1838209 100644 --- a/test/src/Test/Main.purs +++ b/test/src/Test/Main.purs @@ -8,16 +8,18 @@ import Control.Monad.Eff.Random as Rand import Control.Monad.Eff.Exception as Exn import Control.Monad.Trampoline as Trampoline -import Data.HugeNum as HN +import Data.Array as A +import Data.Char as CH +import Data.DateTime as DT import Data.Either (Either(..), isLeft) +import Data.Enum (toEnum) +import Data.HugeNum as HN +import Data.Identity as ID import Data.List as L import Data.Maybe as M import Data.Newtype (un) -import Data.Traversable as TR -import Data.Identity as ID -import Data.Array as A -import Data.Char as CH import Data.String as S +import Data.Traversable as TR import Data.Tuple (uncurry) @@ -31,6 +33,8 @@ import Test.StrongCheck.Arbitrary as SCA import Test.StrongCheck.Gen as Gen import Test.StrongCheck.LCG as LCG +import Partial.Unsafe (unsafePartial) + type TestEffects e = ( console ∷ C.CONSOLE , random ∷ Rand.RANDOM @@ -238,19 +242,15 @@ static = do case t of SD.PlainText _ → pure $ SD.PlainText $ pure "Evaluated plain text!" SD.Numeric _ → pure $ SD.Numeric $ pure $ HN.fromNumber 42.0 - SD.Date _ → pure $ SD.Date $ pure { month : 7, day : 30, year : 1992 } - SD.Time (prec@SD.Minutes) _ → pure $ SD.Time prec $ pure { hours : 4, minutes : 52, seconds : M.Nothing } - SD.Time (prec@SD.Seconds) _ → pure $ SD.Time prec $ pure { hours : 4, minutes : 52, seconds : M.Just 10 } + SD.Date _ → pure $ SD.Date $ pure $ unsafeDate 1992 7 30 + SD.Time (prec@SD.Minutes) _ → pure $ SD.Time prec $ pure $ unsafeTime 4 52 0 + SD.Time (prec@SD.Seconds) _ → pure $ SD.Time prec $ pure $ unsafeTime 4 52 10 SD.DateTime (prec@SD.Minutes) _ → pure $ SD.DateTime prec $ pure $ - { date : { month : 7, day : 30, year : 1992 } - , time : { hours : 4, minutes : 52, seconds : M.Nothing } - } + DT.DateTime (unsafeDate 1992 7 30) (unsafeTime 4 52 0) SD.DateTime (prec@SD.Seconds) _ → pure $ SD.DateTime prec $ pure $ - { date : { month : 7, day : 30, year : 1992 } - , time : { hours : 4, minutes : 52, seconds : M.Just 10 } - } + DT.DateTime (unsafeDate 1992 7 30) (unsafeTime 4 52 10) , value: \_ → pure $ SD.stringValue "Evaluated value!" , list: \_ → pure $ L.singleton $ SD.stringValue "Evaluated list!" } sd @@ -287,6 +287,12 @@ static = do C.log "All static tests passed!" +unsafeDate ∷ Int → Int → Int → DT.Date +unsafeDate y m d = unsafePartial $ M.fromJust $ join $ DT.exactDate <$> toEnum y <*> toEnum m <*> toEnum d + +unsafeTime ∷ Int → Int → Int → DT.Time +unsafeTime h m s = unsafePartial $ M.fromJust $ DT.Time <$> toEnum h <*> toEnum m <*> toEnum s <*> toEnum bottom + generated ∷ ∀ e. Eff (TestEffects e) Unit generated = do C.log "Random documents"