{-# LANGUAGE CPP #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_HADDOCK hide #-}

#if HLINT
#include "cabal_macros.h"
#endif

module Data.Thyme.Format.Internal where

import Prelude
import Control.Applicative
import Data.Attoparsec.ByteString.Char8 (Parser, Result, IResult (..))
import qualified Data.Attoparsec.ByteString.Char8 as P
import qualified Data.ByteString.Char8 as S
import Data.Char
import Data.Int
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text

#if MIN_VERSION_bytestring(0,10,0)
# if MIN_VERSION_bytestring(0,10,2)
import qualified Data.ByteString.Builder as B
# else
import qualified Data.ByteString.Lazy.Builder as B
# endif
import qualified Data.ByteString.Lazy as L
#endif

{-# INLINE utf8Char #-}
{-# INLINE utf8String #-}
utf8Char :: Char -> S.ByteString
utf8String :: String -> S.ByteString
#if MIN_VERSION_bytestring(0,10,0)
utf8Char :: Char -> ByteString
utf8Char = ByteString -> ByteString
L.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
B.toLazyByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Builder
B.charUtf8
utf8String :: String -> ByteString
utf8String = ByteString -> ByteString
L.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
B.toLazyByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Builder
B.stringUtf8
#else
utf8Char = Text.encodeUtf8 . Text.singleton
utf8String = Text.encodeUtf8 . Text.pack
#endif

------------------------------------------------------------------------

{-# INLINE shows02 #-}
shows02 :: Int -> ShowS
shows02 :: Int -> ShowS
shows02 Int
n = if Int
n forall a. Ord a => a -> a -> Bool
< Int
10 then (:) Char
'0' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows Int
n else forall a. Show a => a -> ShowS
shows Int
n

{-# ANN shows_2 "HLint: ignore Use camelCase" #-}
{-# INLINE shows_2 #-}
shows_2 :: Int -> ShowS
shows_2 :: Int -> ShowS
shows_2 Int
n = if Int
n forall a. Ord a => a -> a -> Bool
< Int
10 then (:) Char
' ' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows Int
n else forall a. Show a => a -> ShowS
shows Int
n

{-# INLINE shows03 #-}
shows03 :: Int -> ShowS
shows03 :: Int -> ShowS
shows03 Int
n
    | Int
n forall a. Ord a => a -> a -> Bool
< Int
10 = forall a. [a] -> [a] -> [a]
(++) String
"00" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows Int
n
    | Int
n forall a. Ord a => a -> a -> Bool
< Int
100 = forall a. [a] -> [a] -> [a]
(++) String
"0" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows Int
n
    | Bool
otherwise = forall a. Show a => a -> ShowS
shows Int
n

{-# INLINE showsYear #-}
showsYear :: Int -> ShowS
showsYear :: Int -> ShowS
showsYear n :: Int
n@(forall a. Num a => a -> a
abs -> Int
u)
    | Int
u forall a. Ord a => a -> a -> Bool
< Int
10 = ShowS
neg forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a] -> [a]
(++) String
"000" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows Int
u
    | Int
u forall a. Ord a => a -> a -> Bool
< Int
100 = ShowS
neg forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a] -> [a]
(++) String
"00" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows Int
u
    | Int
u forall a. Ord a => a -> a -> Bool
< Int
1000 = ShowS
neg forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a] -> [a]
(++) String
"0" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows Int
u
    | Bool
otherwise = ShowS
neg forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows Int
u
    where neg :: ShowS
neg = if Int
n forall a. Ord a => a -> a -> Bool
< Int
0 then (:) Char
'-' else forall a. a -> a
id

{-# INLINE fills06 #-}
fills06 :: Int64 -> ShowS
fills06 :: Int64 -> ShowS
fills06 Int64
n
    | Int64
n forall a. Ord a => a -> a -> Bool
< Int64
10 = forall a. [a] -> [a] -> [a]
(++) String
"00000"
    | Int64
n forall a. Ord a => a -> a -> Bool
< Int64
100 = forall a. [a] -> [a] -> [a]
(++) String
"0000"
    | Int64
n forall a. Ord a => a -> a -> Bool
< Int64
1000 = forall a. [a] -> [a] -> [a]
(++) String
"000"
    | Int64
n forall a. Ord a => a -> a -> Bool
< Int64
10000 = forall a. [a] -> [a] -> [a]
(++) String
"00"
    | Int64
n forall a. Ord a => a -> a -> Bool
< Int64
100000 = forall a. [a] -> [a] -> [a]
(++) String
"0"
    | Bool
otherwise = forall a. a -> a
id

{-# INLINE drops0 #-}
drops0 :: Int64 -> ShowS
drops0 :: Int64 -> ShowS
drops0 Int64
n = case forall a. Integral a => a -> a -> (a, a)
divMod Int64
n Int64
10 of
    (Int64
q, Int64
0) -> Int64 -> ShowS
drops0 Int64
q
    (Int64, Int64)
_ -> forall a. Show a => a -> ShowS
shows Int64
n

------------------------------------------------------------------------

{-# INLINEABLE parserToReadS #-}
parserToReadS :: Parser a -> ReadS a
parserToReadS :: forall a. Parser a -> ReadS a
parserToReadS = forall a. (ByteString -> Result a) -> ReadS a
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Parser a -> ByteString -> Result a
P.parse where
    {-# INLINEABLE go #-}
    go :: (S.ByteString -> Result a) -> ReadS a
    go :: forall a. (ByteString -> Result a) -> ReadS a
go ByteString -> Result a
k (forall a. Int -> [a] -> ([a], [a])
splitAt Int
32 -> (String
h, String
t)) = case ByteString -> Result a
k (String -> ByteString
utf8String String
h) of
        -- `date -R | wc -c` is 32 characters
        Fail ByteString
rest [String]
cxts String
msg -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ String
"parserToReadS: ", String
msg
            , String
"; remaining: ", forall a. Show a => a -> String
show (ByteString -> String
utf8Decode ByteString
rest), String
"; stack: ", forall a. Show a => a -> String
show [String]
cxts ]
        Partial ByteString -> Result a
k' -> forall a. (ByteString -> Result a) -> ReadS a
go ByteString -> Result a
k' String
t
        Done ByteString
rest a
a -> forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, ByteString -> String
utf8Decode ByteString
rest forall a. [a] -> [a] -> [a]
++ String
t)

    {-# INLINE utf8Decode #-}
    utf8Decode :: S.ByteString -> String
    utf8Decode :: ByteString -> String
utf8Decode = Text -> String
Text.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
Text.decodeUtf8

{-# INLINE indexOf #-}
indexOf :: [String] -> Parser Int
indexOf :: [String] -> Parser Int
indexOf = forall (f :: * -> *) a. Alternative f => [f a] -> f a
P.choice forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\ Int
i String
s -> Int
i forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ByteString -> Parser ByteString
P.string (String -> ByteString
S.pack String
s)) [Int
0..]

{-# INLINE indexOfCI #-}
indexOfCI :: [String] -> Parser Int
indexOfCI :: [String] -> Parser Int
indexOfCI = forall (f :: * -> *) a. Alternative f => [f a] -> f a
P.choice forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\ Int
i String
s -> Int
i forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> Parser ()
stringCI String
s) [Int
0..]

-- | Case-insensitive UTF-8 ByteString parser
--
-- Matches one character at a time. Slow.
{-# INLINE stringCI #-}
stringCI :: String -> Parser ()
stringCI :: String -> Parser ()
stringCI = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\ Parser ()
p Char
c -> Parser ()
p forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> Parser ()
charCI Char
c) (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

-- | Case-insensitive UTF-8 ByteString parser
--
-- We can't easily perform upper/lower case conversion on the input, so
-- instead we accept either one of @toUpper c@ and @toLower c@.
{-# INLINE charCI #-}
charCI :: Char -> Parser ()
charCI :: Char -> Parser ()
charCI Char
c = if Char
u forall a. Eq a => a -> a -> Bool
== Char
l then Char -> Parser ()
charU8 Char
c else Char -> Parser ()
charU8 Char
l forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> Parser ()
charU8 Char
u where
    l :: Char
l = Char -> Char
toLower Char
c
    u :: Char
u = Char -> Char
toUpper Char
c

{-# INLINE charU8 #-}
charU8 :: Char -> Parser ()
charU8 :: Char -> Parser ()
charU8 Char
c = () forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ByteString -> Parser ByteString
P.string (Char -> ByteString
utf8Char Char
c)

-- | Number may be prefixed with '-'
{-# INLINE negative #-}
negative :: (Integral n) => Parser n -> Parser n
negative :: forall n. Integral n => Parser n -> Parser n
negative Parser n
p = forall a b. (a -> b) -> a -> b
($) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Num a => a -> a
negate forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser Char
P.char Char
'-' forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. a -> a
id) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser n
p

-- | Fixed-length 0-padded decimal
{-# INLINE dec0 #-}
dec0 :: Int -> Parser Int
dec0 :: Int -> Parser Int
dec0 Int
n = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Parser a -> ByteString -> Either String a
P.parseOnly forall a. Integral a => Parser a
P.decimal forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Int -> Parser ByteString
P.take Int
n

-- | Fixed-length space-padded decimal
{-# INLINE dec_ #-}
dec_ :: Int -> Parser Int
dec_ :: Int -> Parser Int
dec_ Int
n = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Parser a -> ByteString -> Either String a
P.parseOnly forall a. Integral a => Parser a
P.decimal
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Char -> Bool) -> ByteString -> ByteString
S.dropWhile Char -> Bool
isSpace forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Parser ByteString
P.take Int
n