module Attoparsec.Time.Pure where

import Attoparsec.Time.Prelude
import qualified Data.ByteString as A


{-# INLINE timeZone #-}
timeZone :: Bool -> Int -> Int -> TimeZone
timeZone :: Bool -> Int -> Int -> TimeZone
timeZone Bool
positive Int
hour Int
minute =
  Int -> TimeZone
minutesToTimeZone (Int -> TimeZone) -> Int -> TimeZone
forall a b. (a -> b) -> a -> b
$
  (Int -> Int) -> (Int -> Int) -> Bool -> Int -> Int
forall a. a -> a -> Bool -> a
bool Int -> Int
forall a. Num a => a -> a
negate Int -> Int
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id Bool
positive (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$
  Int
hour Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
60 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
minute

{-# INLINE day #-}
day :: Int -> Int -> Int -> Day
day :: Int -> Int -> Int -> Day
day Int
y Int
m Int
d =
  Integer -> Int -> Int -> Day
fromGregorian (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y) Int
m Int
d

{-# INLINE timeOfDay #-}
timeOfDay :: Int -> Int -> Pico -> TimeOfDay
timeOfDay :: Int -> Int -> Pico -> TimeOfDay
timeOfDay =
  Int -> Int -> Pico -> TimeOfDay
TimeOfDay

{-# INLINE zonedTime #-}
zonedTime :: Day -> TimeOfDay -> TimeZone -> ZonedTime
zonedTime :: Day -> TimeOfDay -> TimeZone -> ZonedTime
zonedTime Day
day TimeOfDay
tod TimeZone
tz =
  LocalTime -> TimeZone -> ZonedTime
ZonedTime (Day -> TimeOfDay -> LocalTime
LocalTime Day
day TimeOfDay
tod) TimeZone
tz

{-# INLINE utcTimeFromDayAndTimeOfDay #-}
utcTimeFromDayAndTimeOfDay :: Day -> TimeOfDay -> TimeZone -> UTCTime
utcTimeFromDayAndTimeOfDay :: Day -> TimeOfDay -> TimeZone -> UTCTime
utcTimeFromDayAndTimeOfDay Day
day TimeOfDay
tod TimeZone
tz =
  ZonedTime -> UTCTime
zonedTimeToUTC (Day -> TimeOfDay -> TimeZone -> ZonedTime
zonedTime Day
day TimeOfDay
tod TimeZone
tz)

{-# INLINE utcTimeFromComponents #-}
utcTimeFromComponents :: Int -> Int -> Int -> Int -> Int -> Int -> Int -> TimeZone -> UTCTime
utcTimeFromComponents :: Int
-> Int -> Int -> Int -> Int -> Int -> Int -> TimeZone -> UTCTime
utcTimeFromComponents Int
year Int
month Int
day Int
hour Int
minute Int
second Int
millisecond TimeZone
timeZone =
  UTCTime
forall a. HasCallStack => a
undefined

{-# INLINE decimalFromBytes #-}
decimalFromBytes :: Integral decimal => A.ByteString -> decimal
decimalFromBytes :: ByteString -> decimal
decimalFromBytes =
  (decimal -> Word8 -> decimal) -> decimal -> ByteString -> decimal
forall a. (a -> Word8 -> a) -> a -> ByteString -> a
A.foldl' decimal -> Word8 -> decimal
forall a a. (Integral a, Num a) => a -> a -> a
step decimal
0
  where
    step :: a -> a -> a
step a
a a
b =
      a
a a -> a -> a
forall a. Num a => a -> a -> a
* a
10 a -> a -> a
forall a. Num a => a -> a -> a
+ a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
b a -> a -> a
forall a. Num a => a -> a -> a
- a
48

{-# INLINE word8IsAsciiDigit #-}
word8IsAsciiDigit :: Word8 -> Bool
word8IsAsciiDigit :: Word8 -> Bool
word8IsAsciiDigit Word8
w =
  Word8
w Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
48 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
9

{-# INLINE word8IsAsciiAlpha #-}
word8IsAsciiAlpha :: Word8 -> Bool
word8IsAsciiAlpha :: Word8 -> Bool
word8IsAsciiAlpha Word8
x =
  (Word8
x Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
97 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
25) Bool -> Bool -> Bool
|| (Word8
x Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
65 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
25)