{-# LANGUAGE UnicodeSyntax, DeriveDataTypeable, FlexibleContexts #-}

module Data.Dates.Internal where

import Data.Char

import Text.Parsec

-- | Parser version of Prelude.read
tryRead :: (Read a, Stream s m Char) => String -> ParsecT s st m a
tryRead :: String -> ParsecT s st m a
tryRead String
str =
  case ReadS a
forall a. Read a => ReadS a
reads String
str of
    [(a
res, String
"")] -> a -> ParsecT s st m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
res
    [(a, String)]
_ -> String -> ParsecT s st m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> ParsecT s st m a) -> String -> ParsecT s st m a
forall a b. (a -> b) -> a -> b
$ String
"Cannot read: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
str

tryReadInt ∷ (Stream s m Char, Num a) ⇒ String → ParsecT s st m a
tryReadInt :: String -> ParsecT s st m a
tryReadInt String
str =
  if (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit String
str
    then a -> ParsecT s st m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> ParsecT s st m a) -> a -> ParsecT s st m a
forall a b. (a -> b) -> a -> b
$ Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> a) -> Int -> a
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Int) -> Int -> [Int] -> Int
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Int
a Int
b → Int
10Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
aInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
b) Int
0 ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (Char -> Int) -> String -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Int
digitToInt String
str
    else String -> ParsecT s st m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> ParsecT s st m a) -> String -> ParsecT s st m a
forall a b. (a -> b) -> a -> b
$ String
"Cannot read: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
str

-- | Apply parser N times
times ∷ (Stream s m Char)
     ⇒ Int
     → ParsecT s st m t
     → ParsecT s st m [t]
times :: Int -> ParsecT s st m t -> ParsecT s st m [t]
times Int
0 ParsecT s st m t
_ = [t] -> ParsecT s st m [t]
forall (m :: * -> *) a. Monad m => a -> m a
return []
times Int
n ParsecT s st m t
p = do
  [t]
ts ← Int -> ParsecT s st m t -> ParsecT s st m [t]
forall s (m :: * -> *) st t.
Stream s m Char =>
Int -> ParsecT s st m t -> ParsecT s st m [t]
times (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) ParsecT s st m t
p
  Maybe t
t ← ParsecT s st m t -> ParsecT s st m (Maybe t)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
optionMaybe ParsecT s st m t
p
  case Maybe t
t of
    Just t
t' → [t] -> ParsecT s st m [t]
forall (m :: * -> *) a. Monad m => a -> m a
return ([t]
ts [t] -> [t] -> [t]
forall a. [a] -> [a] -> [a]
++ [t
t'])
    Maybe t
Nothing → [t] -> ParsecT s st m [t]
forall (m :: * -> *) a. Monad m => a -> m a
return [t]
ts
                               
-- | Parse natural number of N digits
-- which is not greater than M
number ∷ Stream s m Char
       ⇒ Int   -- ^ Number of digits
       → Int   -- ^ Maximum value
       → ParsecT s st m Int
number :: Int -> Int -> ParsecT s st m Int
number Int
n Int
m = do
  Int
t ← String -> ParsecT s st m Int
forall s (m :: * -> *) a st.
(Stream s m Char, Num a) =>
String -> ParsecT s st m a
tryReadInt (String -> ParsecT s st m Int)
-> ParsecT s st m String -> ParsecT s st m Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Int
n Int -> ParsecT s st m Char -> ParsecT s st m String
forall s (m :: * -> *) st t.
Stream s m Char =>
Int -> ParsecT s st m t -> ParsecT s st m [t]
`times` ParsecT s st m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit)
  if Int
t Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
m
    then String -> ParsecT s st m Int
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"number too large"
    else Int -> ParsecT s st m Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
t

pYear ∷ Stream s m Char => ParsecT s st m Int
pYear :: ParsecT s st m Int
pYear = do
  Int
y ← Int -> Int -> ParsecT s st m Int
forall s (m :: * -> *) st.
Stream s m Char =>
Int -> Int -> ParsecT s st m Int
number Int
4 Int
10000
  if Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2000
    then Int -> ParsecT s st m Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2000)
    else Int -> ParsecT s st m Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
y

pMonth ∷ Stream s m Char => ParsecT s st m Int
pMonth :: ParsecT s st m Int
pMonth = Int -> Int -> ParsecT s st m Int
forall s (m :: * -> *) st.
Stream s m Char =>
Int -> Int -> ParsecT s st m Int
number Int
2 Int
12

pDay ∷ Stream s m Char => ParsecT s st m Int
pDay :: ParsecT s st m Int
pDay = Int -> Int -> ParsecT s st m Int
forall s (m :: * -> *) st.
Stream s m Char =>
Int -> Int -> ParsecT s st m Int
number Int
2 Int
31