{-# 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 (ByteString -> ByteString)
-> (Char -> ByteString) -> Char -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
B.toLazyByteString (Builder -> ByteString) -> (Char -> Builder) -> Char -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Builder
B.charUtf8
utf8String :: String -> ByteString
utf8String = ByteString -> ByteString
L.toStrict (ByteString -> ByteString)
-> (String -> ByteString) -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
B.toLazyByteString (Builder -> ByteString)
-> (String -> Builder) -> String -> ByteString
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 n :: Int
n = if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 10 then (:) '0' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Show a => a -> ShowS
shows Int
n else Int -> ShowS
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 n :: Int
n = if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 10 then (:) ' ' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Show a => a -> ShowS
shows Int
n else Int -> ShowS
forall a. Show a => a -> ShowS
shows Int
n

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

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

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

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

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

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

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

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

-- | Case-insensitive UTF-8 ByteString parser
--
-- Matches one character at a time. Slow.
{-# INLINE stringCI #-}
stringCI :: String -> Parser ()
stringCI :: String -> Parser ByteString ()
stringCI = (Parser ByteString () -> Char -> Parser ByteString ())
-> Parser ByteString () -> String -> Parser ByteString ()
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\ p :: Parser ByteString ()
p c :: Char
c -> Parser ByteString ()
p Parser ByteString ()
-> Parser ByteString () -> Parser ByteString ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> Parser ByteString ()
charCI Char
c) (() -> Parser ByteString ()
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 ByteString ()
charCI c :: Char
c = if Char
u Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
l then Char -> Parser ByteString ()
charU8 Char
c else Char -> Parser ByteString ()
charU8 Char
l Parser ByteString ()
-> Parser ByteString () -> Parser ByteString ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> Parser ByteString ()
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 ByteString ()
charU8 c :: Char
c = () () -> Parser ByteString ByteString -> Parser ByteString ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ByteString -> Parser ByteString ByteString
P.string (Char -> ByteString
utf8Char Char
c)

-- | Number may be prefixed with '-'
{-# INLINE negative #-}
negative :: (Integral n) => Parser n -> Parser n
negative :: Parser n -> Parser n
negative p :: Parser n
p = (n -> n) -> n -> n
forall a b. (a -> b) -> a -> b
($) ((n -> n) -> n -> n)
-> Parser ByteString (n -> n) -> Parser ByteString (n -> n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (n -> n
forall a. Num a => a -> a
negate (n -> n) -> Parser ByteString Char -> Parser ByteString (n -> n)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser ByteString Char
P.char '-' Parser ByteString (n -> n)
-> Parser ByteString (n -> n) -> Parser ByteString (n -> n)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (n -> n) -> Parser ByteString (n -> n)
forall (f :: * -> *) a. Applicative f => a -> f a
pure n -> n
forall a. a -> a
id) Parser ByteString (n -> n) -> Parser n -> Parser n
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 n :: Int
n = (String -> Parser Int)
-> (Int -> Parser Int) -> Either String Int -> Parser Int
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Parser Int
forall (m :: * -> *) a. MonadFail m => String -> m a
fail Int -> Parser Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Int -> Parser Int)
-> (ByteString -> Either String Int) -> ByteString -> Parser Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser Int -> ByteString -> Either String Int
forall a. Parser a -> ByteString -> Either String a
P.parseOnly Parser Int
forall a. Integral a => Parser a
P.decimal (ByteString -> Parser Int)
-> Parser ByteString ByteString -> Parser Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Int -> Parser ByteString ByteString
P.take Int
n

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