parseTime

parse-time.hs

#!/usr/bin/env magix
#!magix haskell
#!haskellPackages bytestring criterion attoparsec extra
#!ghcFlags -O2
-- #!/usr/bin/env nix-shell
-- #! nix-shell -I nixpkgs=https://github.com/nixos/nixpkgs/archive/nixos-24.11.tar.gz
-- #! nix-shell -p "haskell.packages.ghc96.ghcWithPackages (pkgs: with pkgs; [time criterion attoparsec aeson extra ]) " ghcid
-- #! nix-shell -i ghcid


{-# LANGUAGE OverloadedStrings #-}

module Main(main) where

import Data.Text (Text)
import Data.Attoparsec.Text
import Data.Time.Clock
import Data.Time.Calendar
import Data.Tuple.Extra
import qualified Data.Text as T
import Data.Char (ord, isDigit)
import Data.Ratio ((%))
import Control.Applicative
import Criterion.Main
import Data.Time.Clock.POSIX

-- parseUTCTime :: String -> IO ()
-- parseUTCTime s =
--    (parseTimeM True defaultTimeLocale "%FT%TZ" s
--     <|> parseTimeM True defaultTimeLocale "%FT%T%QZ" s
--     <|> parseTimeM True defaultTimeLocale "%F %T%Q" s
--     <|> parseTimeM True defaultTimeLocale "%F %T" s)
-- pure ()

{-# INLINE parseYMD #-}
parseYMD :: Parser Day
parseYMD = do
  y <- decimal
  char '-'
  m <- decimal
  char '-'
  d <- decimal
  pure $! fromGregorian y m d

{-# INLINE parseHMT #-}
parseHMT :: Parser DiffTime
parseHMT = do
  h <- decimal
  char ':'
  m <- decimal
  char ':'
  s <- decimal
  pure $! secondsToDiffTime (h * 3600 + m * 60 + s)

{-# INLINE toFractionalSecs #-}
toFractionalSecs :: Text -> Rational
toFractionalSecs !t =
  let
    step (!num, !l) c = (num * 10 + fromIntegral (ord c - 48), l+1)
    (!num, !l) = T.foldl' step (0, 0) t
    den = 10 ^ l
  in num % den

{-# INLINE parseFractionalSecs #-}
parseFractionalSecs :: Parser NominalDiffTime
parseFractionalSecs = do
  char '.'
  fromRational . toFractionalSecs <$> takeWhile1 isDigit

{-# INLINE parseTime #-}
parseTime :: Parser UTCTime
parseTime = do
  day <- parseYMD
  anyChar -- Only space and T are valid though
  diffTime <- parseHMT
  optionalFraction <- optional parseFractionalSecs
  let
    !d = UTCTime day diffTime
  maybe
    (pure d)
    (\fr -> pure $ addUTCTime fr d)
    optionalFraction

parseUTCTime :: Text -> Int
parseUTCTime t =
  let
    Right d =  parseOnly parseTime t
  in do
    (fromEnum $ utcTimeToPOSIXSeconds d) + 1

main :: IO ()
main =
  defaultMain
  [
    bgroup "parse" [ bench "%FT%TZ"  $ nf  parseUTCTime "2025-02-25T00:00:00Z"
                 , bench "%FT%T%QZ"  $ nf  parseUTCTime "2025-02-25T00:00:00.1234Z"
                 , bench "%F %T%Q"  $ nf  parseUTCTime "2025-02-25 00:00:00.123"
                 , bench "%F %T"  $ nf  parseUTCTime "2025-02-25 00:00:00"
               ]
  ]