{-# OPTIONS_GHC -fno-warn-name-shadowing #-}

module Hydrogen.Util.Read where

import Hydrogen.Prelude

import Data.Time.Calendar.OrdinalDate


tryRead :: (Monad m) => ReadS a -> String -> m a
tryRead p s = case p s of
    [(val, "")] -> return val
    [] -> fail "no parse"
    _ -> fail "ambiguous parse"

tryReads :: (Monad m, Read a) => String -> m a
tryReads = tryRead reads

firstJust :: [a -> Maybe b] -> a -> Maybe b
firstJust (f : fs) v = case f v of
    Nothing -> firstJust fs v
    x -> x
firstJust [] _ = Nothing


ignoreUnderscores :: String -> String
ignoreUnderscores = \case
    x : xs -> x : ignore xs
    xs -> xs
  where
    ignore = \case
        xs@(x : '_' : _) | not (isAlphaNum x) -> xs
        '_' : x : xs | isAlphaNum x -> x : ignore xs
        x : xs -> x : ignore xs
        xs -> xs

tryReadDecimal :: String -> Maybe Rational
tryReadDecimal = \case
    ('-' : xs) -> negate <$> readRational xs
    ('+' : xs) -> readRational xs
    ('.' : xs) -> readRational ("0." ++ xs)
    xs -> readRational xs
  where
    readRational = tryRead readFloat . ignoreUnderscores

tryReadRational :: String -> Maybe Rational
tryReadRational xs = case right of
    (_ : right') -> liftM2 (%) numer denom
      where
        numer = tryRead reads left
        denom = tryRead reads right'

    _ -> Nothing
  where
    (left, right) = span (/= '/') (ignoreUnderscores xs)

tryReadHex :: String -> Maybe Rational
tryReadHex = tryRead readHex . ignoreUnderscores . hex
  where
    hex = \case
      '0' : 'x' : xs -> xs
      _ -> ""

tryReadUUID :: String -> Maybe UUID
tryReadUUID = tryRead reads

tryReadVersion :: String -> Maybe Version
tryReadVersion = \case
    ('v' : xs) -> tryRead reads xs
    _ -> fail "no version"

tryReadDateTime :: String -> Maybe (Maybe ZonedTime)
tryReadDateTime xs = case xs =~ dateTime of

    [[_, y, m, d, h, min, _, s, s', z, zm, _, zs]]
        -> Just (liftM2 ZonedTime (liftM2 LocalTime date time) zone)
      where
        (year, month, day, hour, minute) = (read y, read m, read d, read h, read min)
        sec = read ((if null s then "0" else s) ++ (if null s' then ".0" else s'))

        time = makeTimeOfDayValid hour minute sec
        date = fromGregorianValid year month day

        zone = Just $ case z of
            "Z" -> utc
            ('-' : _) -> minutesToTimeZone (negate zn)
            _ -> minutesToTimeZone zn
          where
            zn = read zm * 60 + (if zs == "" then 0 else read zs)

    _ -> Nothing

  where
    date = "([0-9]{4})-?([0-9]{2})-?([0-9]{2})"
    time = "([0-9]{2}):?([0-9]{2})(:?([0-9]{2})(\\.[0-9]{1,12})?)?"
    timeZone = "(Z|[+-]([0-9]{1,2})(:?([0-9]{2}))?)"
    dateTime = concat ["^", date, "T?", time, timeZone, "$"]

tryReadDate :: String -> Maybe (Maybe Day)
tryReadDate xs = case xs =~ date of
    [[_, y, _, m, d, ""]] -> Just (fromGregorianValid year month day)
      where
        (year, month, day) = (read y, read m, read d)

    [[_, y, _, _, _, d]] -> Just (fromOrdinalDateValid year day)
      where
        (year, day) = (read y, read d)

    _ -> Nothing
  where
    date = "^([0-9]{4})-(([0-9]{2})-([0-9]{2})|([0-9]{3}))$"

tryReadTime :: String -> Maybe (Maybe TimeOfDay)
tryReadTime xs = case xs =~ time of
    [[_, h, m, _, s]] -> Just (makeTimeOfDayValid hour min sec)
      where
        (hour, min, sec) = (read h, read m, if null s then 0 else read s)

    _ -> Nothing
  where
    time = "^([0-9]{2}):([0-9]{2})(:([0-9]{2}))?$"

tryReadBool :: String -> Maybe Bool
tryReadBool = \case
    "true" -> return True
    "TRUE" -> return True
    "True" -> return True
    "false" -> return False
    "False" -> return False
    "FALSE" -> return False
    _ -> Nothing