Skip to content
This repository was archived by the owner on Jun 15, 2023. It is now read-only.

Commit af63cbf

Browse files
garybgaryb
authored
Merge pull request #69 from garyb/time-secs
SD-1773: Support seconds values in times
2 parents bf8a179 + 88a95de commit af63cbf

File tree

4 files changed

+119
-50
lines changed

4 files changed

+119
-50
lines changed

‎src/Text/Markdown/SlamDown/Parser/Inline.purs‎

Lines changed: 34 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -15,7 +15,6 @@ import Data.Bifunctor (lmap)
1515
import Data.Const (Const(..))
1616
import Data.Either (Either(..))
1717
import Data.Foldable (elem)
18-
import Data.Functor ((<$))
1918
import Data.Functor.Compose (Compose(..))
2019
import Data.HugeNum as HN
2120
import Data.Int as Int
@@ -291,30 +290,36 @@ inlines = L.many inline2 <* PS.eof
291290
pure $ Right $ SD.TextBox $ SD.transTextBox (M.Just >>> Compose) def
292291
M.Nothing →
293292
pure $ Left case template of
294-
SD.DateTime _ →
293+
SD.DateTime SD.Minutes _ →
295294
"Incorrect datetime default value, please use \"YYYY-MM-DD HH:mm\" or \"YYYY-MM-DDTHH:mm\" format"
295+
SD.DateTime SD.Seconds _ →
296+
"Incorrect datetime default value, please use \"YYYY-MM-DD HH:mm:ss\" or \"YYYY-MM-DDTHH:mm:ss\" format"
296297
SD.Date _ →
297298
"Incorrect date default value, please use \"YYYY-MM-DD\" format"
298-
SD.Time _ →
299-
"Incorrect time default value, please use \"HH:mm\" or \"HH:mm:ss\" format"
299+
SD.Time SD.Minutes _ →
300+
"Incorrect time default value, please use \"HH:mm\" format"
301+
SD.Time SD.Seconds _ →
302+
"Incorrect time default value, please use \"HH:mm:ss\" format"
300303
SD.Numeric _ →
301304
"Incorrect numeric default value"
302305
SD.PlainText _ →
303306
"Incorrect default value"
304307

305308
parseTextBoxTemplate ∷ P.Parser String (SD.TextBox (Const Unit))
306309
parseTextBoxTemplate =
307-
SD.DateTime (Const unit) <$ PC.try parseDateTimeTemplate
310+
SD.DateTime SD.Seconds (Const unit) <$ PC.try (parseDateTimeTemplate SD.Seconds)
311+
<|> SD.DateTime SD.Minutes (Const unit) <$ PC.try (parseDateTimeTemplate SD.Minutes)
308312
<|> SD.Date (Const unit) <$ PC.try parseDateTemplate
309-
<|> SD.Time (Const unit) <$ PC.try parseTimeTemplate
313+
<|> SD.Time SD.Seconds (Const unit) <$ PC.try (parseTimeTemplate SD.Seconds)
314+
<|> SD.Time SD.Minutes (Const unit) <$ PC.try (parseTimeTemplate SD.Minutes)
310315
<|> SD.Numeric (Const unit) <$ PC.try parseNumericTemplate
311316
<|> SD.PlainText (Const unit) <$ parsePlainTextTemplate
312317

313318
where
314-
parseDateTimeTemplate = do
319+
parseDateTimeTemplate prec = do
315320
parseDateTemplate
316321
PU.skipSpaces
317-
parseTimeTemplate
322+
parseTimeTemplate prec
318323

319324
parseDateTemplate = do
320325
und
@@ -323,10 +328,13 @@ inlines = L.many inline2 <* PS.eof
323328
PU.skipSpaces *> dash *> PU.skipSpaces
324329
und
325330

326-
parseTimeTemplate = do
331+
parseTimeTemplate prec = do
327332
und
328333
PU.skipSpaces *> colon *> PU.skipSpaces
329334
und
335+
when (prec == SD.Seconds) do
336+
PU.skipSpaces *> colon *> PU.skipSpaces
337+
void und
330338

331339
parseNumericTemplate = do
332340
hash
@@ -404,17 +412,17 @@ parseTextBox
404412
→ P.Parser String (SD.TextBox g)
405413
parseTextBox isPlainText eta template =
406414
case template of
407-
SD.DateTime _ → SD.DateTime <$> eta parseDateTimeValue
415+
SD.DateTime prec _ → SD.DateTime prec <$> eta (parseDateTimeValue prec)
408416
SD.Date _ → SD.Date <$> eta parseDateValue
409-
SD.Time _ → SD.Time <$> eta parseTimeValue
417+
SD.Time prec _ → SD.Time prec <$> eta (parseTimeValue prec)
410418
SD.Numeric _ → SD.Numeric <$> eta parseNumericValue
411419
SD.PlainText _ → SD.PlainText <$> eta parsePlainTextValue
412420

413421
where
414-
parseDateTimeValue = do
422+
parseDateTimeValue prec = do
415423
date ← parseDateValue
416424
(PC.try $ void $ PS.string "T") <|> PU.skipSpaces
417-
time ← parseTimeValue
425+
time ← parseTimeValue prec
418426
pure { date, time }
419427

420428
parseDateValue = do
@@ -427,12 +435,23 @@ parseTextBox isPlainText eta template =
427435
when (day > 31) $ P.fail "Incorrect day"
428436
pure { month, day, year }
429437

430-
parseTimeValue = do
438+
parseTimeValue prec = do
431439
hours ← natural
432440
when (hours > 23) $ P.fail "Incorrect hours"
433441
PU.skipSpaces *> colon *> PU.skipSpaces
434442
minutes ← natural
435443
when (minutes > 59) $ P.fail "Incorrect minutes"
444+
seconds ← case prec of
445+
SD.Minutes -> do
446+
scolon ← PC.try $ PC.optionMaybe $ PU.skipSpaces *> colon
447+
when (M.isJust scolon) $ P.fail "Unexpected seconds component"
448+
pure M.Nothing
449+
SD.Seconds -> do
450+
PU.skipSpaces *> colon *> PU.skipSpaces
451+
secs ← natural
452+
when (secs > 59) $ P.fail "Incorrect seconds"
453+
PU.skipSpaces
454+
pure $ M.Just secs
436455
PU.skipSpaces
437456
amPm ←
438457
PC.optionMaybe $
@@ -447,7 +466,7 @@ parseTextBox isPlainText eta template =
447466
else if isAM && hours == 12
448467
then 0
449468
else hours
450-
pure { hours : hours', minutes }
469+
pure { hours : hours', minutes, seconds }
451470

452471
parseNumericValue = do
453472
sign ← PC.try (-1 <$ PS.char '-') <|> pure 1

‎src/Text/Markdown/SlamDown/Pretty.purs‎

Lines changed: 16 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -117,8 +117,8 @@ prettyPrintTextBoxValue t =
117117
let s = HN.toString def in
118118
M.fromMaybe s $ S.stripSuffix "." $ HN.toString def
119119
SD.Date (Identity def) → prettyPrintDate def
120-
SD.Time (Identity def) → prettyPrintTime def
121-
SD.DateTime (Identity def) → prettyPrintDateTime def
120+
SD.Time prec (Identity def) → prettyPrintTime prec def
121+
SD.DateTime prec (Identity def) → prettyPrintDateTime prec def
122122

123123
prettyPrintDate ∷ SD.DateValue → String
124124
prettyPrintDate { day, month, year } =
@@ -128,17 +128,20 @@ prettyPrintDate { day, month, year } =
128128
<> "-"
129129
<> printIntPadded 2 day
130130

131-
prettyPrintTime ∷ SD.TimeValue → String
132-
prettyPrintTime { hours, minutes }=
131+
prettyPrintTime ∷ SD.TimePrecision → SD.TimeValue → String
132+
prettyPrintTime prec { hours, minutes, seconds }=
133133
printIntPadded 2 hours
134134
<> ":"
135135
<> printIntPadded 2 minutes
136+
<> case prec of
137+
SD.Seconds -> ":" <> printIntPadded 2 (M.fromMaybe 0 seconds)
138+
_ -> ""
136139

137-
prettyPrintDateTime ∷ SD.DateTimeValue → String
138-
prettyPrintDateTime { date, time } =
140+
prettyPrintDateTime ∷ SD.TimePrecision → SD.DateTimeValue → String
141+
prettyPrintDateTime prec { date, time } =
139142
prettyPrintDate date
140143
<> "T"
141-
<> prettyPrintTime time
144+
<> prettyPrintTime prec time
142145

143146
printIntPadded ∷ Int → Int → String
144147
printIntPadded l i =
@@ -160,17 +163,19 @@ prettyPrintTextBox t =
160163
SD.PlainText _ → "______"
161164
SD.Numeric _ → "#______"
162165
SD.Date _ → "__-__-____"
163-
SD.Time _ → "__:__"
164-
SD.DateTime _ → "__-__-____ __:__"
166+
SD.Time SD.Minutes _ → "__:__"
167+
SD.Time SD.Seconds _ → "__:__:__"
168+
SD.DateTime SD.Minutes _ → "__-__-____ __:__"
169+
SD.DateTime SD.Seconds _ → "__-__-____ __:__:__"
165170

166171
prettyPrintDefault ∷ SD.TextBox SD.Expr → String
167172
prettyPrintDefault t =
168173
case t of
169174
SD.PlainText def → prettyPrintExpr id id def
170175
SD.Numeric def → prettyPrintExpr id HN.toString def
171176
SD.Date def → prettyPrintExpr id prettyPrintDate def
172-
SD.Time def → prettyPrintExpr id prettyPrintTime def
173-
SD.DateTime def → prettyPrintExpr id prettyPrintDateTime def
177+
SD.Time prec def → prettyPrintExpr id (prettyPrintTime prec) def
178+
SD.DateTime prec def → prettyPrintExpr id (prettyPrintDateTime prec) def
174179

175180

176181
prettyPrintFormElement ∷ ∀ a. (SD.Value a) ⇒ SD.FormField a → String

‎src/Text/Markdown/SlamDown/Syntax/TextBox.purs‎

Lines changed: 50 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -2,6 +2,7 @@ module Text.Markdown.SlamDown.Syntax.TextBox
22
( TimeValue
33
, DateValue
44
, DateTimeValue
5+
, TimePrecision(..)
56
, TextBox(..)
67
, transTextBox
78
, traverseTextBox
@@ -16,13 +17,15 @@ import Prelude
1617
import Data.Function (on)
1718
import Data.HugeNum as HN
1819
import Data.Identity (Identity(..), runIdentity)
20+
import Data.Maybe (Maybe(..))
1921

2022
import Test.StrongCheck.Arbitrary as SCA
2123
import Test.StrongCheck.Gen as Gen
2224

2325
type TimeValue =
2426
{ hours ∷ Int
2527
, minutes ∷ Int
28+
, seconds ∷ Maybe Int
2629
}
2730

2831
newtype TimeValueP = TimeValueP TimeValue
@@ -55,12 +58,16 @@ instance arbitraryTimeValueP ∷ SCA.Arbitrary TimeValueP where
5558
arbitrary = do
5659
hours ← Gen.chooseInt 0.0 12.0
5760
minutes ← Gen.chooseInt 0.0 60.0
58-
pure $ TimeValueP { hours , minutes }
61+
secs ← Gen.chooseInt 0.0 60.0
62+
b <- (_ < 0.5) <$> Gen.choose 0.0 1.0
63+
let seconds = if b then Nothing else Just secs
64+
pure $ TimeValueP { hours , minutes , seconds }
5965

6066
instance coarbitraryTimeValueP :: SCA.Coarbitrary TimeValueP where
61-
coarbitrary (TimeValueP { hours, minutes }) gen = do
67+
coarbitrary (TimeValueP { hours, minutes, seconds }) gen = do
6268
SCA.coarbitrary hours gen
6369
SCA.coarbitrary minutes gen
70+
SCA.coarbitrary seconds gen
6471

6572
type DateValue =
6673
{ month ∷ Int
@@ -153,12 +160,33 @@ instance coarbitraryDateTimeValueP :: SCA.Coarbitrary DateTimeValueP where
153160
SCA.coarbitrary (DateValueP date) gen
154161
SCA.coarbitrary (TimeValueP time) gen
155162

163+
data TimePrecision
164+
= Minutes
165+
| Seconds
166+
167+
derive instance eqTimePrecision :: Eq TimePrecision
168+
derive instance ordTimePrecision :: Ord TimePrecision
169+
170+
instance showTimePrecision :: Show TimePrecision where
171+
show Minutes = "Minutes"
172+
show Seconds = "Seconds"
173+
174+
instance arbitraryTimePrecision ∷ SCA.Arbitrary TimePrecision where
175+
arbitrary =
176+
Gen.chooseInt 0.0 1.0 <#> case _ of
177+
0 → Minutes
178+
_ → Seconds
179+
180+
instance coarbitraryTimePrecision :: SCA.Coarbitrary TimePrecision where
181+
coarbitrary Minutes = SCA.coarbitrary 1
182+
coarbitrary Seconds = SCA.coarbitrary 2
183+
156184
data TextBox f
157185
= PlainText (f String)
158186
| Numeric (f HN.HugeNum)
159187
| Date (f DateValue)
160-
| Time (f TimeValue)
161-
| DateTime (f DateTimeValue)
188+
| Time TimePrecision (f TimeValue)
189+
| DateTime TimePrecision (f DateTimeValue)
162190

163191
transTextBox
164192
∷ ∀ f g
@@ -180,17 +208,17 @@ traverseTextBox eta t =
180208
PlainText def → PlainText <$> eta def
181209
Numeric def → Numeric <$> eta def
182210
Date def → Date <$> eta def
183-
Time def → Time <$> eta def
184-
DateTime def → DateTime <$> eta def
211+
Time prec def → Time prec <$> eta def
212+
DateTime prec def → DateTime prec <$> eta def
185213

186214
instance showTextBox ∷ (Functor f, Show (f String), Show (f HN.HugeNum), Show (f TimeValueP), Show (f DateValueP), Show (f DateTimeValueP)) ⇒ Show (TextBox f) where
187215
show =
188216
case _ of
189217
PlainText def → "(PlainText " <> show def <> ")"
190218
Numeric def → "(Numeric " <> show def <> ")"
191219
Date def → "(Date " <> show (DateValueP <$> def) <> ")"
192-
Time def → "(Time " <> show (TimeValueP <$> def) <> ")"
193-
DateTime def → "(DateTime " <> show (DateTimeValueP <$> def) <> ")"
220+
Time prec def → "(Time " <> show prec <> " " <> show (TimeValueP <$> def) <> ")"
221+
DateTime prec def → "(DateTime " <> show prec <> " " <> show (DateTimeValueP <$> def) <> ")"
194222

195223
instance ordTextBox ∷ (Functor f, Ord (f String), Ord (f HN.HugeNum), Ord (f TimeValueP), Ord (f DateValueP), Ord (f DateTimeValueP)) ⇒ Ord (TextBox f) where
196224
compare =
@@ -207,20 +235,20 @@ instance ordTextBox ∷ (Functor f, Ord (f String), Ord (f HN.HugeNum), Ord (f T
207235
Date _, _ → LT
208236
_, Date _ → GT
209237

210-
Time t1, Time t2 → on compare (map TimeValueP) t1 t2
211-
Time _, _ → LT
212-
_, Time _ → GT
238+
Time prec1 t1, Time prec2 t2 → compare prec1 prec2 <> on compare (map TimeValueP) t1 t2
239+
Time _ _, _ → LT
240+
_, Time _ _ → GT
213241

214-
DateTime d1, DateTime d2 → on compare (map DateTimeValueP) d1 d2
242+
DateTime prec1 d1, DateTime prec2 d2 → compare prec1 prec2 <> on compare (map DateTimeValueP) d1 d2
215243

216244
instance eqTextBox ∷ (Functor f, Eq (f String), Eq (f HN.HugeNum), Eq (f TimeValueP), Eq (f DateValueP), Eq (f DateTimeValueP)) ⇒ Eq (TextBox f) where
217245
eq =
218246
case _, _ of
219247
PlainText d1, PlainText d2 → d1 == d2
220248
Numeric d1, Numeric d2 → d1 == d2
221249
Date d1, Date d2 → on eq (map DateValueP) d1 d2
222-
Time d1, Time d2 → on eq (map TimeValueP) d1 d2
223-
DateTime d1, DateTime d2 → on eq (map DateTimeValueP) d1 d2
250+
Time prec1 d1, Time prec2 d2 → prec1 == prec2 && on eq (map TimeValueP) d1 d2
251+
DateTime prec1 d1, DateTime prec2 d2 → prec1 == prec2 && on eq (map DateTimeValueP) d1 d2
224252
_, _ → false
225253

226254
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
@@ -230,8 +258,8 @@ instance arbitraryTextBox ∷ (Functor f, SCA.Arbitrary (f String), SCA.Arbitrar
230258
0 → PlainText <$> SCA.arbitrary
231259
1 → Numeric <<< map HN.fromNumber <$> SCA.arbitrary
232260
2 → Date <<< map getDateValueP <$> SCA.arbitrary
233-
3 → Time <<< map getTimeValueP <$> SCA.arbitrary
234-
4 → DateTime <<< map getDateTimeValueP <$> SCA.arbitrary
261+
3 → Time <$> SCA.arbitrary <*> (map getTimeValueP <$> SCA.arbitrary)
262+
4 → DateTime <$> SCA.arbitrary <*> (map getDateTimeValueP <$> SCA.arbitrary)
235263
_ → PlainText <$> SCA.arbitrary
236264

237265
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
@@ -240,5 +268,9 @@ instance coarbitraryTextBox :: (Functor f, SCA.Coarbitrary (f String), SCA.Coarb
240268
PlainText d -> SCA.coarbitrary d
241269
Numeric d -> SCA.coarbitrary $ HN.toNumber <$> d
242270
Date d -> SCA.coarbitrary $ DateValueP <$> d
243-
Time d -> SCA.coarbitrary $ TimeValueP <$> d
244-
DateTime d -> SCA.coarbitrary $ DateTimeValueP <$> d
271+
Time prec d -> do
272+
SCA.coarbitrary prec
273+
SCA.coarbitrary $ TimeValueP <$> d
274+
DateTime prec d -> do
275+
SCA.coarbitrary prec
276+
SCA.coarbitrary $ DateTimeValueP <$> d

‎test/src/Test/Main.purs‎

Lines changed: 19 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -9,7 +9,7 @@ import Control.Monad.Eff.Exception as Exn
99
import Control.Monad.Trampoline as Trampoline
1010

1111
import Data.HugeNum as HN
12-
import Data.Either (Either(..))
12+
import Data.Either (Either(..), isLeft)
1313
import Data.List as L
1414
import Data.Maybe as M
1515
import Data.Traversable as TR
@@ -72,6 +72,9 @@ testDocument sd = do
7272
<> show parsed
7373
SC.assert (parsed == sd SC.<?> "Test failed")
7474

75+
failDocument ∷ ∀ e. Either String (SD.SlamDownP NonEmptyString) → Eff (TestEffects e) Unit
76+
failDocument sd = SC.assert (isLeft sd SC.<?> "Test failed")
77+
7578
static ∷ ∀ e. Eff (TestEffects e) Unit
7679
static = do
7780
testDocument $ SDP.parseMd "Paragraph"
@@ -234,11 +237,17 @@ static = do
234237
SD.PlainText _ → pure $ SD.PlainText $ pure "Evaluated plain text!"
235238
SD.Numeric _ → pure $ SD.Numeric $ pure $ HN.fromNumber 42.0
236239
SD.Date _ → pure $ SD.Date $ pure { month : 7, day : 30, year : 1992 }
237-
SD.Time _ → pure $ SD.Time $ pure { hours : 4, minutes : 52 }
238-
SD.DateTime _ →
239-
pure $ SD.DateTime $ pure $
240+
SD.Time (prec@SD.Minutes) _ → pure $ SD.Time prec $ pure { hours : 4, minutes : 52, seconds : M.Nothing }
241+
SD.Time (prec@SD.Seconds) _ → pure $ SD.Time prec $ pure { hours : 4, minutes : 52, seconds : M.Just 10 }
242+
SD.DateTime (prec@SD.Minutes) _ →
243+
pure $ SD.DateTime prec $ pure $
244+
{ date : { month : 7, day : 30, year : 1992 }
245+
, time : { hours : 4, minutes : 52, seconds : M.Nothing }
246+
}
247+
SD.DateTime (prec@SD.Seconds) _ →
248+
pure $ SD.DateTime prec $ pure $
240249
{ date : { month : 7, day : 30, year : 1992 }
241-
, time : { hours : 4, minutes : 52 }
250+
, time : { hours : 4, minutes : 52, seconds : M.Just 10 }
242251
}
243252
, value: \_ → pure $ SD.stringValue "Evaluated value!"
244253
, list: \_ → pure $ L.singleton $ SD.stringValue "Evaluated list!"
@@ -256,6 +265,9 @@ static = do
256265
testDocument $ SDP.parseMd "start = __ - __ - ____ (06-06-2015)"
257266
testDocument $ SDP.parseMd "start = __ - __ - ____ (!`...`)"
258267
testDocument $ SDP.parseMd "start = __ : __ (10:32 PM)"
268+
failDocument $ SDP.parseMd "start = __ : __ (10:32:46 PM)"
269+
failDocument $ SDP.parseMd "start = __ : __ : __ (10:32 PM)"
270+
testDocument $ SDP.parseMd "start = __ : __ : __ (10:32:46 PM)"
259271
testDocument $ SDP.parseMd "start = __ : __ (!`...`)"
260272
testDocument $ SDP.parseMd "start = __-__-____ __:__ (06-06-2015 12:00 PM)"
261273
testDocument $ SDP.parseMd "start = __ - __ - ____ __ : __ (!`...`)"
@@ -264,7 +276,8 @@ static = do
264276
testDocument $ SDP.parseMd "city = {BOS, SFO, NYC}"
265277
testDocument $ SDP.parseMd "start = __ - __ - ____"
266278
testDocument $ SDP.parseMd "start = __ : __"
267-
testDocument $ SDP.parseMd "start = __ - __ - ____ __ : __"
279+
testDocument $ SDP.parseMd "start = __ : __ : __"
280+
testDocument $ SDP.parseMd "start = __ - __ - ____ __ : __ : __"
268281
testDocument $ SDP.parseMd "zip* = ________"
269282
testDocument $ SDP.parseMd "[numeric field] = #______ (23)"
270283
testDocument $ SDP.parseMd "i9a0qvg8* = ______ (9a0qvg8h)"

0 commit comments

Comments
 (0)