module Hasql.Postgres.Parser where import Hasql.Postgres.Prelude hiding (take) import Data.Attoparsec.ByteString import Data.Attoparsec.ByteString.Char8 import qualified Data.ByteString import qualified Data.Text import qualified Data.Text.Encoding import qualified Data.Text.Lazy import qualified Data.Text.Lazy.Encoding type P = Parser run :: ByteString -> P a -> Either Text a run input parser = left fromString $ parseOnly (parser <* endOfInput) input -- ** Parser ------------------------- labeling :: String -> Parser a -> Parser a labeling n p = p n bool :: P Bool bool = labeling "bool" $ ((string "true" <|> string "t" <|> string "True" <|> string "1") *> pure True) <|> ((string "false" <|> string "f" <|> string "False" <|> string "0") *> pure False) utf8Char :: P Char utf8Char = labeling "utf8Char" $ asum $ map byLength [1..4] where byLength l = do b <- take l t <- either (const empty) return $ Data.Text.Encoding.decodeUtf8' b (c, _) <- maybe empty return $ Data.Text.uncons t return c utf8LazyText :: P Data.Text.Lazy.Text utf8LazyText = labeling "utf8LazyText" $ do b <- takeLazyByteString either (const empty) return $ Data.Text.Lazy.Encoding.decodeUtf8' b utf8Text :: P Text utf8Text = Data.Text.Lazy.toStrict <$> utf8LazyText charUnit :: Char -> P () charUnit c = skip ((==) (fromIntegral (ord c))) -- | A signed integral value from a sequence of characters. {-# INLINE integral #-} integral :: (Integral a, Num a) => P a integral = signed decimal -- | An unsigned integral value from a sequence of characters. {-# INLINE unsignedIntegral #-} unsignedIntegral :: (Integral a, Num a) => P a unsignedIntegral = decimal -- | An integral value from a single character. {-# INLINE integralDigit #-} integralDigit :: Integral a => P a integralDigit = satisfyWith (subtract 48 . fromIntegral) (\n -> n < 10 && n >= 0) day :: P Day day = do y <- unsignedIntegral charUnit '-' m <- unsignedIntegral charUnit '-' d <- unsignedIntegral maybe empty return (fromGregorianValid y m d) timeOfDay :: P TimeOfDay timeOfDay = do h <- unsignedIntegral charUnit ':' m <- unsignedIntegral charUnit ':' s <- unsignedIntegral p <- (charUnit '.' *> decimals) <|> pure 0 maybe empty return (makeTimeOfDayValid h m (fromIntegral s + p)) where decimals = do (b, i) <- match unsignedIntegral return $ fromIntegral i / (10 ^ Data.ByteString.length b) localTime :: P LocalTime localTime = LocalTime <$> day <*> (charUnit ' ' *> timeOfDay) timeZoneTuple :: P (Bool, Int, Int, Int) timeZoneTuple = do p <- (charUnit '+' *> pure True) <|> (charUnit '-' *> pure False) h <- unsignedIntegral m <- (charUnit ':' *> unsignedIntegral) <|> pure 0 s <- (charUnit ':' *> unsignedIntegral) <|> pure 0 return $! (p, h, m, s) timeZone :: P TimeZone timeZone = do (p, h, m, s) <- timeZoneTuple return $! minutesToTimeZone ((Hasql.Postgres.Prelude.bool negate id p) (60 * h + m)) -- | -- Takes seconds in timezone into account. zonedTime :: P ZonedTime zonedTime = do LocalTime d t <- localTime (zp, zh, zm, zs) <- timeZoneTuple return $ ZonedTime (LocalTime d (timeOfDayDiffSecs zs t)) (composeTimezone zp zh zm) where timeOfDayDiffSecs s = if s /= 0 then \t -> timeToTimeOfDay $ timeOfDayToTime t - fromIntegral s else id composeTimezone p h m = minutesToTimeZone ((Hasql.Postgres.Prelude.bool negate id p) (60 * h + m)) utcTime :: P UTCTime utcTime = UTCTime <$> day <*> (charUnit ' ' *> diffTime) diffTime :: P DiffTime diffTime = timeOfDayToTime <$> timeOfDay