1
1
module Data.Formatter.Interval
2
- -- TODO parser should't be exposed
3
2
( parseDuration
4
3
) where
5
4
@@ -11,10 +10,14 @@ import Text.Parsing.Parser.Combinators as PC
11
10
import Text.Parsing.Parser.String as PS
12
11
import Control.Alt ((<|>))
13
12
import Data.Array (some )
14
- import Data.Function ( on )
13
+ import Data.Foldable ( class Foldable , fold )
15
14
import Data.Formatter.Internal (digit , foldDigits )
15
+ import Data.Function (on )
16
16
import Data.Int (toNumber , floor )
17
- import Data.Monoid (mempty )
17
+ import Data.Maybe (Maybe , maybe )
18
+ import Data.Monoid (class Monoid , mempty )
19
+ import Data.Traversable (sequence )
20
+ import Data.Tuple (Tuple (..))
18
21
19
22
20
23
numOfDigits ∷ Int → Int
@@ -40,31 +43,40 @@ number = (+)
40
43
<$> (integer <#> toNumber)
41
44
<*> (PC .option 0.0 $ PC .try $ PS .oneOf [' .' , ' ,' ] *> fractional)
42
45
46
+ durationParser :: Array (Tuple (Number -> I.Duration ) String ) -> P.Parser String I.Duration
47
+ durationParser arr = arr
48
+ <#> applyDurations
49
+ # sequence
50
+ <#> foldFoldableMaybe
51
+
52
+ applyDurations :: Tuple (Number -> I.Duration ) String -> P.Parser String (Maybe I.Duration )
53
+ applyDurations (Tuple f c) = PC .optionMaybe $ PC .try (f <$> component c)
54
+
55
+ foldFoldableMaybe :: ∀ f a . (Foldable f , Monoid a ) => f (Maybe a ) -> a
56
+ foldFoldableMaybe = fold >>> unMaybe
57
+
58
+ unMaybe :: ∀ a . (Monoid a ) => Maybe a -> a
59
+ unMaybe = maybe mempty id
60
+
43
61
component ∷ String → P.Parser String Number
44
62
component designator = number <* PS .string designator
45
63
46
- tryOr :: ∀ a . a → P.Parser String a → P.Parser String a
47
- tryOr a p = PC .option a $ PC .try p
64
+ tryM :: ∀ a . (Monoid a ) => P.Parser String a → P.Parser String a
65
+ tryM p = PC .option mempty $ PC .try p
66
+
67
+ parseIsoDuration :: P.Parser String I.IsoDuration
68
+ parseIsoDuration = do
69
+ dur ← parseDuration
70
+ case I .mkIsoDuration dur of
71
+ Nothing -> PC .fail " extracted Duration is not valid ISO duration"
72
+ Just a -> pure a
48
73
49
74
parseDuration :: P.Parser String I.Duration
50
- parseDuration = PS .string " P" *> (weekDuration <|> fullDuration) <* PS .eof
75
+ parseDuration =
76
+ PS .string " P" *> (weekDuration <|> fullDuration) <* PS .eof
51
77
where
52
- weekDuration :: P.Parser String I.Duration
53
- weekDuration = PC .try $ I .week <$> component " W"
54
-
55
- fullDuration ∷ P.Parser String I.Duration
78
+ weekDuration = durationParser [ Tuple I .week " W" ]
56
79
fullDuration = append <$> durationDatePart <*> durationTimePart
57
-
58
- durationDatePart ∷ P.Parser String I.Duration
59
- durationDatePart = (\y m d → I .year y <> I .month m <> I .day d)
60
- <$> (tryOr 0.0 $ component " Y" )
61
- <*> (tryOr 0.0 $ component " M" )
62
- <*> (tryOr 0.0 $ component " D" )
63
-
64
- durationTimePart ∷ P.Parser String I.Duration
65
- durationTimePart = tryOr mempty $
66
- PS .string " T" *>
67
- pure (\h m s → I .hours h <> I .minutes m <> I .seconds s)
68
- <*> (tryOr 0.0 $ component " H" )
69
- <*> (tryOr 0.0 $ component " M" )
70
- <*> (tryOr 0.0 $ component " S" )
80
+ durationDatePart = durationParser [ Tuple I .year " Y" , Tuple I .month " M" , Tuple I .day " D" ]
81
+ durationTimePart = tryM $ PS .string " T" *>
82
+ (durationParser [ Tuple I .hours " H" , Tuple I .minutes " M" , Tuple I .seconds " S" ])
0 commit comments