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