hydrogen-data-0.12: src/Hydrogen/Data.hs

module Hydrogen.Data (
    Value
  , MkValue (..)
  , mkLink
  , readValue
  , isInteger
  , isNumber
  , isVersion
  , isUUID
  , isDateTime
  , isDate
  , isTime
  , isLink
  , isNull
  , isNotANumber
  , isPositive
  , isZero
  , isNegative
  , isNonNegative
  , getNumber
  , getVersion
  , getUUID
  , getDateTime
  , getDate
  , getTime
  , getLink
  , getInteger
  ) where

import Hydrogen.Prelude hiding (isNumber)
import Hydrogen.Parsing hiding (parse)

import qualified Data.Version

data Value where
    DNumber :: Rational -> Value
    DVersion :: Version -> Value
    DUUID :: UUID -> Value
    DDateTime :: ZonedTime -> Value
    DDate :: Day -> Value
    DTime :: TimeOfDay -> Value
    DLink :: String -> Value
    DNull :: Value
    DNotANumber :: Value
  deriving (Eq, Generic, Typeable, Show, Read)

instance Serialize Value


readValue :: String -> Maybe Value
readValue = firstJust [
    fmap DNumber . tryReadDecimal
  , fmap DDateTime . join . tryReadDateTime
  , fmap DDate . join . tryReadDate
  , fmap DTime . join . tryReadTime
  , fmap DLink . tryReadLink
  , fmap DVersion . tryReadVersion
  , fmap DUUID . tryReadUUID
  ]

class MkValue a where mkValue :: a -> Value

instance MkValue Int where
    mkValue = DNumber . fromIntegral

instance MkValue Integer where
    mkValue = DNumber . fromIntegral

instance MkValue Double where
    mkValue d
        | isNaN d   = DNotANumber
        | otherwise = DNumber $ toRational d

instance MkValue Float where
    mkValue d
        | isNaN d   = DNotANumber
        | otherwise = DNumber $ toRational d

instance MkValue (Ratio Integer) where
    mkValue = DNumber

instance MkValue ZonedTime where
    mkValue = DDateTime

instance MkValue TimeOfDay where
    mkValue = DTime

instance MkValue Day where
    mkValue = DDate

instance MkValue Version where
    mkValue = DVersion

instance MkValue Data.Version.Version where
    mkValue = DVersion . fromDataVersion

instance MkValue () where
    mkValue _ = DNull

instance (MkValue a, MkValue b) => MkValue (Either a b) where
    mkValue = either mkValue mkValue

instance MkValue a => MkValue (Maybe a) where
    mkValue = maybe DNull mkValue

mkLink :: String -> Maybe Value
mkLink = fmap DLink . tryReadLink


isNumber, isVersion, isUUID, isDateTime, isDate, isTime, isLink,
  isInteger, isNull, isNotANumber, isPositive, isZero, isNegative, isNonNegative
    :: Value -> Bool

isPositive = \case
    DNumber r -> numerator r > 0
    _ -> False

isZero = \case
    DNumber r -> numerator r == 0
    _ -> False

isNegative = \case
    DNumber r -> numerator r < 0
    _ -> False

isNonNegative = not . isNegative

isInteger = \case
    DNumber r -> denominator r == 1
    _ -> False

isNumber = \case
    DNumber _ -> True
    _ -> False

isVersion = \case
    DVersion _ -> True
    _ -> False

isUUID = \case
    DUUID _ -> True
    _ -> False

isDateTime = \case
    DDateTime _ -> True
    _ -> False

isDate = \case
    DDate _ -> True
    _ -> False

isTime = \case
    DTime _ -> True
    _ -> False

isLink = \case
    DLink _ -> True
    _ -> False

isNull = \case
    DNull -> True
    _ -> False

isNotANumber = \case
    DNotANumber -> True
    _ -> False


getInteger :: Monad m => Value -> m Integer
getInteger = \case
    DNumber r | denominator r == 1 -> return (numerator r)
    _ -> fail "not an Integer"

getNumber :: Monad m => Value -> m Rational
getNumber = \case
    DNumber r -> return r
    _ -> fail "not a Number"

getVersion :: Monad m => Value -> m Version
getVersion = \case
    DVersion v -> return v
    _ -> fail "not a Version"

getUUID :: Monad m => Value -> m UUID
getUUID = \case
    DUUID u -> return u
    _ -> fail "not a UUID"

getDateTime :: Monad m => Value -> m ZonedTime
getDateTime = \case
    DDateTime d -> return d
    _ -> fail "not a DateTime"

getDate :: Monad m => Value -> m Day
getDate = \case
    DDate d -> return d
    _ -> fail "not a Date"

getTime :: Monad m => Value -> m TimeOfDay
getTime = \case
    DTime d -> return d
    _ -> fail "not a Time"

getLink :: Monad m => Value -> m String
getLink = \case
    DLink l -> return l
    _ -> fail "not a Link"