module Data.Time.Format.Parse.Class
(
ParseNumericPadding(..),
ParseTime(..),
parseSpecifiers,
timeSubstituteTimeSpecifier,
timeParseTimeSpecifier,
durationParseTimeSpecifier,
)
where
import Control.Applicative hiding (optional,many)
import Data.Char
import Data.Maybe
import Data.Time.Format.Locale
import Text.ParserCombinators.ReadP
data ParseNumericPadding = NoPadding | SpacePadding | ZeroPadding
class ParseTime t where
substituteTimeSpecifier :: proxy t -> TimeLocale -> Char -> Maybe String
substituteTimeSpecifier _ _ _ = Maybe String
forall a. Maybe a
Nothing
parseTimeSpecifier :: proxy t -> TimeLocale -> Maybe ParseNumericPadding -> Char -> ReadP String
buildTime :: TimeLocale
-> [(Char,String)]
-> Maybe t
charCI :: Char -> ReadP Char
charCI :: Char -> ReadP Char
charCI c :: Char
c = (Char -> Bool) -> ReadP Char
satisfy (\x :: Char
x -> Char -> Char
toUpper Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Char
toUpper Char
x)
stringCI :: String -> ReadP String
stringCI :: String -> ReadP String
stringCI this :: String
this = do
let
scan :: String -> String -> ReadP String
scan [] _ = String -> ReadP String
forall (m :: * -> *) a. Monad m => a -> m a
return String
this
scan (x :: Char
x:xs :: String
xs) (y :: Char
y:ys :: String
ys) | Char -> Char
toUpper Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Char
toUpper Char
y = do
Char
_ <- ReadP Char
get
String -> String -> ReadP String
scan String
xs String
ys
scan _ _ = ReadP String
forall a. ReadP a
pfail
String
s <- ReadP String
look
String -> String -> ReadP String
scan String
this String
s
parseSpecifiers :: ParseTime t => proxy t -> TimeLocale -> String -> ReadP [(Char,String)]
parseSpecifiers :: proxy t -> TimeLocale -> String -> ReadP [(Char, String)]
parseSpecifiers pt :: proxy t
pt locale :: TimeLocale
locale = let
parse :: String -> ReadP [(Char,String)]
parse :: String -> ReadP [(Char, String)]
parse [] = [(Char, String)] -> ReadP [(Char, String)]
forall (m :: * -> *) a. Monad m => a -> m a
return []
parse ('%':cs :: String
cs) = String -> ReadP [(Char, String)]
parse1 String
cs
parse (c :: Char
c:cs :: String
cs) | Char -> Bool
isSpace Char
c = do
Char
_ <- (Char -> Bool) -> ReadP Char
satisfy Char -> Bool
isSpace
case String
cs of
(c' :: Char
c':_) | Char -> Bool
isSpace Char
c' -> () -> ReadP ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
_ -> ReadP ()
skipSpaces
String -> ReadP [(Char, String)]
parse String
cs
parse (c :: Char
c:cs :: String
cs) = do
Char
_ <- Char -> ReadP Char
charCI Char
c
String -> ReadP [(Char, String)]
parse String
cs
parse1 :: String -> ReadP [(Char,String)]
parse1 :: String -> ReadP [(Char, String)]
parse1 ('-':cs :: String
cs) = Maybe ParseNumericPadding -> String -> ReadP [(Char, String)]
parse2 (ParseNumericPadding -> Maybe ParseNumericPadding
forall a. a -> Maybe a
Just ParseNumericPadding
NoPadding) String
cs
parse1 ('_':cs :: String
cs) = Maybe ParseNumericPadding -> String -> ReadP [(Char, String)]
parse2 (ParseNumericPadding -> Maybe ParseNumericPadding
forall a. a -> Maybe a
Just ParseNumericPadding
SpacePadding) String
cs
parse1 ('0':cs :: String
cs) = Maybe ParseNumericPadding -> String -> ReadP [(Char, String)]
parse2 (ParseNumericPadding -> Maybe ParseNumericPadding
forall a. a -> Maybe a
Just ParseNumericPadding
ZeroPadding) String
cs
parse1 cs :: String
cs = Maybe ParseNumericPadding -> String -> ReadP [(Char, String)]
parse2 Maybe ParseNumericPadding
forall a. Maybe a
Nothing String
cs
parse2 :: Maybe ParseNumericPadding -> String -> ReadP [(Char,String)]
parse2 :: Maybe ParseNumericPadding -> String -> ReadP [(Char, String)]
parse2 mpad :: Maybe ParseNumericPadding
mpad ('E':cs :: String
cs) = Maybe ParseNumericPadding
-> Bool -> String -> ReadP [(Char, String)]
parse3 Maybe ParseNumericPadding
mpad Bool
True String
cs
parse2 mpad :: Maybe ParseNumericPadding
mpad cs :: String
cs = Maybe ParseNumericPadding
-> Bool -> String -> ReadP [(Char, String)]
parse3 Maybe ParseNumericPadding
mpad Bool
False String
cs
parse3 :: Maybe ParseNumericPadding -> Bool -> String -> ReadP [(Char,String)]
parse3 :: Maybe ParseNumericPadding
-> Bool -> String -> ReadP [(Char, String)]
parse3 _ _ ('%':cs :: String
cs) = do
Char
_ <- Char -> ReadP Char
char '%'
String -> ReadP [(Char, String)]
parse String
cs
parse3 _ _ (c :: Char
c:cs :: String
cs) | Just s :: String
s <- proxy t -> TimeLocale -> Char -> Maybe String
forall t (proxy :: * -> *).
ParseTime t =>
proxy t -> TimeLocale -> Char -> Maybe String
substituteTimeSpecifier proxy t
pt TimeLocale
locale Char
c = String -> ReadP [(Char, String)]
parse (String -> ReadP [(Char, String)])
-> String -> ReadP [(Char, String)]
forall a b. (a -> b) -> a -> b
$ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
cs
parse3 mpad :: Maybe ParseNumericPadding
mpad _alt :: Bool
_alt (c :: Char
c:cs :: String
cs) = do
String
str <- proxy t
-> TimeLocale -> Maybe ParseNumericPadding -> Char -> ReadP String
forall t (proxy :: * -> *).
ParseTime t =>
proxy t
-> TimeLocale -> Maybe ParseNumericPadding -> Char -> ReadP String
parseTimeSpecifier proxy t
pt TimeLocale
locale Maybe ParseNumericPadding
mpad Char
c
[(Char, String)]
specs <- String -> ReadP [(Char, String)]
parse String
cs
[(Char, String)] -> ReadP [(Char, String)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Char, String)] -> ReadP [(Char, String)])
-> [(Char, String)] -> ReadP [(Char, String)]
forall a b. (a -> b) -> a -> b
$ (Char
c,String
str) (Char, String) -> [(Char, String)] -> [(Char, String)]
forall a. a -> [a] -> [a]
: [(Char, String)]
specs
parse3 _ _ [] = [(Char, String)] -> ReadP [(Char, String)]
forall (m :: * -> *) a. Monad m => a -> m a
return []
in String -> ReadP [(Char, String)]
parse
parsePaddedDigits :: ParseNumericPadding -> Int -> ReadP String
parsePaddedDigits :: ParseNumericPadding -> Int -> ReadP String
parsePaddedDigits ZeroPadding n :: Int
n = Int -> ReadP Char -> ReadP String
forall a. Int -> ReadP a -> ReadP [a]
count Int
n ((Char -> Bool) -> ReadP Char
satisfy Char -> Bool
isDigit)
parsePaddedDigits SpacePadding _n :: Int
_n = ReadP ()
skipSpaces ReadP () -> ReadP String -> ReadP String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ReadP Char -> ReadP String
forall a. ReadP a -> ReadP [a]
many1 ((Char -> Bool) -> ReadP Char
satisfy Char -> Bool
isDigit)
parsePaddedDigits NoPadding _n :: Int
_n = ReadP Char -> ReadP String
forall a. ReadP a -> ReadP [a]
many1 ((Char -> Bool) -> ReadP Char
satisfy Char -> Bool
isDigit)
parsePaddedSignedDigits :: ParseNumericPadding -> Int -> ReadP String
parsePaddedSignedDigits :: ParseNumericPadding -> Int -> ReadP String
parsePaddedSignedDigits pad :: ParseNumericPadding
pad n :: Int
n = do
String
sign <- String -> ReadP String -> ReadP String
forall a. a -> ReadP a -> ReadP a
option "" (ReadP String -> ReadP String) -> ReadP String -> ReadP String
forall a b. (a -> b) -> a -> b
$ Char -> ReadP Char
char '-' ReadP Char -> ReadP String -> ReadP String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> ReadP String
forall (m :: * -> *) a. Monad m => a -> m a
return "-"
String
digits <- ParseNumericPadding -> Int -> ReadP String
parsePaddedDigits ParseNumericPadding
pad Int
n
String -> ReadP String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> ReadP String) -> String -> ReadP String
forall a b. (a -> b) -> a -> b
$ String
sign String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
digits
parseSignedDecimal :: ReadP String
parseSignedDecimal :: ReadP String
parseSignedDecimal = do
String
sign <- String -> ReadP String -> ReadP String
forall a. a -> ReadP a -> ReadP a
option "" (ReadP String -> ReadP String) -> ReadP String -> ReadP String
forall a b. (a -> b) -> a -> b
$ Char -> ReadP Char
char '-' ReadP Char -> ReadP String -> ReadP String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> ReadP String
forall (m :: * -> *) a. Monad m => a -> m a
return "-"
ReadP ()
skipSpaces
String
digits <- ReadP Char -> ReadP String
forall a. ReadP a -> ReadP [a]
many1 (ReadP Char -> ReadP String) -> ReadP Char -> ReadP String
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ReadP Char
satisfy Char -> Bool
isDigit
String
decimaldigits <- String -> ReadP String -> ReadP String
forall a. a -> ReadP a -> ReadP a
option "" (ReadP String -> ReadP String) -> ReadP String -> ReadP String
forall a b. (a -> b) -> a -> b
$ do
Char
_ <- Char -> ReadP Char
char '.'
String
dd <- ReadP Char -> ReadP String
forall a. ReadP a -> ReadP [a]
many (ReadP Char -> ReadP String) -> ReadP Char -> ReadP String
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ReadP Char
satisfy Char -> Bool
isDigit
String -> ReadP String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> ReadP String) -> String -> ReadP String
forall a b. (a -> b) -> a -> b
$ '.'Char -> String -> String
forall a. a -> [a] -> [a]
:String
dd
String -> ReadP String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> ReadP String) -> String -> ReadP String
forall a b. (a -> b) -> a -> b
$ String
sign String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
digits String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
decimaldigits
timeParseTimeSpecifier :: TimeLocale -> Maybe ParseNumericPadding -> Char -> ReadP String
timeParseTimeSpecifier :: TimeLocale -> Maybe ParseNumericPadding -> Char -> ReadP String
timeParseTimeSpecifier l :: TimeLocale
l mpad :: Maybe ParseNumericPadding
mpad c :: Char
c = let
digits :: ParseNumericPadding -> Int -> ReadP String
digits pad :: ParseNumericPadding
pad = ParseNumericPadding -> Int -> ReadP String
parsePaddedDigits (ParseNumericPadding
-> Maybe ParseNumericPadding -> ParseNumericPadding
forall a. a -> Maybe a -> a
fromMaybe ParseNumericPadding
pad Maybe ParseNumericPadding
mpad)
oneOf :: [String] -> ReadP String
oneOf = [ReadP String] -> ReadP String
forall a. [ReadP a] -> ReadP a
choice ([ReadP String] -> ReadP String)
-> ([String] -> [ReadP String]) -> [String] -> ReadP String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> ReadP String) -> [String] -> [ReadP String]
forall a b. (a -> b) -> [a] -> [b]
map String -> ReadP String
stringCI
numericTZ :: ReadP String
numericTZ = do
Char
s <- [ReadP Char] -> ReadP Char
forall a. [ReadP a] -> ReadP a
choice [Char -> ReadP Char
char '+', Char -> ReadP Char
char '-']
String
h <- ParseNumericPadding -> Int -> ReadP String
parsePaddedDigits ParseNumericPadding
ZeroPadding 2
ReadP Char -> ReadP ()
forall a. ReadP a -> ReadP ()
optional (Char -> ReadP Char
char ':')
String
m <- ParseNumericPadding -> Int -> ReadP String
parsePaddedDigits ParseNumericPadding
ZeroPadding 2
String -> ReadP String
forall (m :: * -> *) a. Monad m => a -> m a
return (Char
sChar -> String -> String
forall a. a -> [a] -> [a]
:String
hString -> String -> String
forall a. [a] -> [a] -> [a]
++String
m)
in case Char
c of
'C' -> ParseNumericPadding -> Int -> ReadP String
digits ParseNumericPadding
SpacePadding 2
'f' -> ParseNumericPadding -> Int -> ReadP String
digits ParseNumericPadding
SpacePadding 2
'Y' -> ParseNumericPadding -> Int -> ReadP String
digits ParseNumericPadding
SpacePadding 4
'G' -> ParseNumericPadding -> Int -> ReadP String
digits ParseNumericPadding
SpacePadding 4
'y' -> ParseNumericPadding -> Int -> ReadP String
digits ParseNumericPadding
ZeroPadding 2
'g' -> ParseNumericPadding -> Int -> ReadP String
digits ParseNumericPadding
ZeroPadding 2
'B' -> [String] -> ReadP String
oneOf (((String, String) -> String) -> [(String, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> String
forall a b. (a, b) -> a
fst (TimeLocale -> [(String, String)]
months TimeLocale
l))
'b' -> [String] -> ReadP String
oneOf (((String, String) -> String) -> [(String, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> String
forall a b. (a, b) -> b
snd (TimeLocale -> [(String, String)]
months TimeLocale
l))
'm' -> ParseNumericPadding -> Int -> ReadP String
digits ParseNumericPadding
ZeroPadding 2
'd' -> ParseNumericPadding -> Int -> ReadP String
digits ParseNumericPadding
ZeroPadding 2
'e' -> ParseNumericPadding -> Int -> ReadP String
digits ParseNumericPadding
SpacePadding 2
'V' -> ParseNumericPadding -> Int -> ReadP String
digits ParseNumericPadding
ZeroPadding 2
'U' -> ParseNumericPadding -> Int -> ReadP String
digits ParseNumericPadding
ZeroPadding 2
'W' -> ParseNumericPadding -> Int -> ReadP String
digits ParseNumericPadding
ZeroPadding 2
'u' -> [String] -> ReadP String
oneOf ([String] -> ReadP String) -> [String] -> ReadP String
forall a b. (a -> b) -> a -> b
$ (Char -> String) -> String -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Char -> String -> String
forall a. a -> [a] -> [a]
:[]) ['1'..'7']
'a' -> [String] -> ReadP String
oneOf (((String, String) -> String) -> [(String, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> String
forall a b. (a, b) -> b
snd (TimeLocale -> [(String, String)]
wDays TimeLocale
l))
'A' -> [String] -> ReadP String
oneOf (((String, String) -> String) -> [(String, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> String
forall a b. (a, b) -> a
fst (TimeLocale -> [(String, String)]
wDays TimeLocale
l))
'w' -> [String] -> ReadP String
oneOf ([String] -> ReadP String) -> [String] -> ReadP String
forall a b. (a -> b) -> a -> b
$ (Char -> String) -> String -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Char -> String -> String
forall a. a -> [a] -> [a]
:[]) ['0'..'6']
'j' -> ParseNumericPadding -> Int -> ReadP String
digits ParseNumericPadding
ZeroPadding 3
'P' -> [String] -> ReadP String
oneOf (let (am :: String
am,pm :: String
pm) = TimeLocale -> (String, String)
amPm TimeLocale
l in [String
am, String
pm])
'p' -> [String] -> ReadP String
oneOf (let (am :: String
am,pm :: String
pm) = TimeLocale -> (String, String)
amPm TimeLocale
l in [String
am, String
pm])
'H' -> ParseNumericPadding -> Int -> ReadP String
digits ParseNumericPadding
ZeroPadding 2
'k' -> ParseNumericPadding -> Int -> ReadP String
digits ParseNumericPadding
SpacePadding 2
'I' -> ParseNumericPadding -> Int -> ReadP String
digits ParseNumericPadding
ZeroPadding 2
'l' -> ParseNumericPadding -> Int -> ReadP String
digits ParseNumericPadding
SpacePadding 2
'M' -> ParseNumericPadding -> Int -> ReadP String
digits ParseNumericPadding
ZeroPadding 2
'S' -> ParseNumericPadding -> Int -> ReadP String
digits ParseNumericPadding
ZeroPadding 2
'q' -> ParseNumericPadding -> Int -> ReadP String
digits ParseNumericPadding
ZeroPadding 12
'Q' -> (Char -> String -> String)
-> ReadP Char -> ReadP String -> ReadP String
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (:) (Char -> ReadP Char
char '.') ((Char -> Bool) -> ReadP String
munch Char -> Bool
isDigit) ReadP String -> ReadP String -> ReadP String
forall a. ReadP a -> ReadP a -> ReadP a
<++ String -> ReadP String
forall (m :: * -> *) a. Monad m => a -> m a
return ""
'z' -> ReadP String
numericTZ
'Z' -> (Char -> Bool) -> ReadP String
munch1 Char -> Bool
isAlpha ReadP String -> ReadP String -> ReadP String
forall a. ReadP a -> ReadP a -> ReadP a
<++
ReadP String
numericTZ
's' -> (Char -> ReadP Char
char '-' ReadP Char -> ReadP String -> ReadP String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (String -> String) -> ReadP String -> ReadP String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ('-'Char -> String -> String
forall a. a -> [a] -> [a]
:) ((Char -> Bool) -> ReadP String
munch1 Char -> Bool
isDigit))
ReadP String -> ReadP String -> ReadP String
forall a. ReadP a -> ReadP a -> ReadP a
<++ (Char -> Bool) -> ReadP String
munch1 Char -> Bool
isDigit
_ -> String -> ReadP String
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> ReadP String) -> String -> ReadP String
forall a b. (a -> b) -> a -> b
$ "Unknown format character: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char -> String
forall a. Show a => a -> String
show Char
c
timeSubstituteTimeSpecifier :: TimeLocale -> Char -> Maybe String
timeSubstituteTimeSpecifier :: TimeLocale -> Char -> Maybe String
timeSubstituteTimeSpecifier l :: TimeLocale
l 'c' = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ TimeLocale -> String
dateTimeFmt TimeLocale
l
timeSubstituteTimeSpecifier _ 'R' = String -> Maybe String
forall a. a -> Maybe a
Just "%H:%M"
timeSubstituteTimeSpecifier _ 'T' = String -> Maybe String
forall a. a -> Maybe a
Just "%H:%M:%S"
timeSubstituteTimeSpecifier l :: TimeLocale
l 'X' = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ TimeLocale -> String
timeFmt TimeLocale
l
timeSubstituteTimeSpecifier l :: TimeLocale
l 'r' = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ TimeLocale -> String
time12Fmt TimeLocale
l
timeSubstituteTimeSpecifier _ 'D' = String -> Maybe String
forall a. a -> Maybe a
Just "%m/%d/%y"
timeSubstituteTimeSpecifier _ 'F' = String -> Maybe String
forall a. a -> Maybe a
Just "%Y-%m-%d"
timeSubstituteTimeSpecifier l :: TimeLocale
l 'x' = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ TimeLocale -> String
dateFmt TimeLocale
l
timeSubstituteTimeSpecifier _ 'h' = String -> Maybe String
forall a. a -> Maybe a
Just "%b"
timeSubstituteTimeSpecifier _ _ = Maybe String
forall a. Maybe a
Nothing
durationParseTimeSpecifier :: TimeLocale -> Maybe ParseNumericPadding -> Char -> ReadP String
durationParseTimeSpecifier :: TimeLocale -> Maybe ParseNumericPadding -> Char -> ReadP String
durationParseTimeSpecifier _ mpad :: Maybe ParseNumericPadding
mpad c :: Char
c = let
padopt :: Int -> ReadP String
padopt = ParseNumericPadding -> Int -> ReadP String
parsePaddedSignedDigits (ParseNumericPadding -> Int -> ReadP String)
-> ParseNumericPadding -> Int -> ReadP String
forall a b. (a -> b) -> a -> b
$ ParseNumericPadding
-> Maybe ParseNumericPadding -> ParseNumericPadding
forall a. a -> Maybe a -> a
fromMaybe ParseNumericPadding
NoPadding Maybe ParseNumericPadding
mpad
in case Char
c of
'y' -> Int -> ReadP String
padopt 1
'b' -> Int -> ReadP String
padopt 1
'B' -> Int -> ReadP String
padopt 2
'w' -> Int -> ReadP String
padopt 1
'd' -> Int -> ReadP String
padopt 1
'D' -> Int -> ReadP String
padopt 1
'h' -> Int -> ReadP String
padopt 1
'H' -> Int -> ReadP String
padopt 2
'm' -> Int -> ReadP String
padopt 1
'M' -> Int -> ReadP String
padopt 2
's' -> ReadP String
parseSignedDecimal
'S' -> ReadP String
parseSignedDecimal
_ -> String -> ReadP String
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> ReadP String) -> String -> ReadP String
forall a b. (a -> b) -> a -> b
$ "Unknown format character: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char -> String
forall a. Show a => a -> String
show Char
c