0 | module IotaTime.Pattern.Offset
2 | import Data.String.Parser
3 | import IotaTime.Internal.Text
4 | import IotaTime.Offset
5 | import IotaTime.Pattern
9 | digit : PatternParser Char
10 | digit = Parser.satisfy (\value => value >= '0' && value <= '9') <?> "digit"
12 | twoDigits : PatternParser Integer
16 | pure ((cast tens - cast '0') * 10 + cast units - cast '0')
18 | offsetValue : String -> Bool -> PatternParser (Either PatternError Offset)
19 | offsetValue separator withSeconds = do
20 | sign <- (Parser.char '-' *> pure (-
1)) <|> (Parser.char '+' *> pure 1)
21 | valueHours <- twoDigits
22 | ignore (Parser.string separator)
23 | valueMinutes <- twoDigits
24 | valueSeconds <- if withSeconds
25 | then Parser.string separator *> twoDigits
27 | if valueMinutes > 59 || valueSeconds > 59
28 | then pure (Left (InvalidValue "invalid offset component"))
29 | else pure (case refineOffsetSeconds
30 | (sign * (valueHours * 3600 + valueMinutes * 60 + valueSeconds)) of
31 | Left _ => Left (InvalidValue "offset is outside -18:00 to +18:00")
32 | Right value => Right value)
34 | renderOffset : String -> Bool -> Offset -> String
35 | renderOffset separator withSeconds value =
36 | let totalSeconds = totalOffsetSeconds value
37 | magnitude = abs totalSeconds
38 | valueHours = magnitude `div` 3600
39 | valueMinutes = magnitude `div` 60 `mod` 60
40 | valueSeconds = magnitude `mod` 60
41 | suffix = if withSeconds
42 | then separator ++ zeroPadInteger 2 valueSeconds
44 | in (if totalSeconds < 0 then "-" else "+") ++
45 | zeroPadInteger 2 valueHours ++ separator ++
46 | zeroPadInteger 2 valueMinutes ++ suffix
48 | offsetPattern : String -> Bool -> Pattern Offset Offset
49 | offsetPattern separator withSeconds = MkPattern
52 | (map (map const) (offsetValue separator withSeconds))
53 | (renderOffset separator withSeconds)
57 | pOffset : Pattern Offset Offset
58 | pOffset = offsetPattern ":" False
62 | pOffsetFull : Pattern Offset Offset
63 | pOffsetFull = offsetPattern ":" True
67 | pOffsetZ : Pattern Offset Offset
68 | pOffsetZ = MkPattern
71 | ((Parser.char 'Z' *> pure (Right (const empty))) <|>
72 | map (map const) (offsetValue ":" False))
73 | (\value => if totalOffsetSeconds value == 0
75 | else renderOffset ":" False value)
79 | pOffsetCompact : Pattern Offset Offset
80 | pOffsetCompact = offsetPattern "" False