hydrogen-data 0.10 → 0.12

raw patch · 4 files changed

+155/−278 lines, 4 filesdep −containersdep −hydrogen-syntaxdep −nicifydep ~hydrogen-parsingdep ~hydrogen-preludePVP ok

version bump matches the API change (PVP)

Dependencies removed: containers, hydrogen-syntax, nicify, parsec, uuid

Dependency ranges changed: hydrogen-parsing, hydrogen-prelude

API changes (from Hackage documentation)

Files

• hydrogen-data.cabal +28/−39
• src/Hydrogen/Data.hs +127/−78
• src/Hydrogen/Data/Parser.hs +0/−83
• src/Hydrogen/Data/Types.hs +0/−78

@@ -1,43 +1,32 @@-name:                 hydrogen-data-version:              0.10-homepage:             https://scravy.de/hydrogen-data/-synopsis:             Hydrogen Data-license:              BSD3-license-file:         LICENSE-extra-source-files:   CHANGELOG.md, README.md-author:               Julian Fleischer-maintainer:           julian@scravy.de-category:             Language-build-type:           Simple-cabal-version:        >=1.14+name:                   hydrogen-data+version:                0.12+homepage:               https://scravy.de/hydrogen-data/+synopsis:               Hydrogen Data+license:                BSD3+license-file:           LICENSE+extra-source-files:     CHANGELOG.md, README.md+author:                 Julian Fleischer+maintainer:             julian@scravy.de+category:               Language+build-type:             Simple+cabal-version:          >=1.14  source-repository head-    type:             git-    location:         https://github.com/scravy/hydrogen-data+    type:               git+    location:           https://github.com/scravy/hydrogen-data  library-  exposed-modules:    Hydrogen.Data-                      , Hydrogen.Data.Parser-                      , Hydrogen.Data.Types-  build-depends:      base ==4.7.*-                      , containers ==0.5.*-                      , hydrogen-prelude ==0.10-                      , hydrogen-parsing ==0.10-                      , hydrogen-syntax ==0.10-                      , nicify ==1.1.*-                      , parsec ==3.1.*-                      , uuid ==1.3.*-  hs-source-dirs:     src-  ghc-options:        -Wall-  default-language:   Haskell2010-  default-extensions:  CPP-                       , DeriveDataTypeable-                       , DeriveGeneric-                       , EmptyCase-                       , FlexibleContexts-                       , GADTs-                       , LambdaCase-                       , MultiWayIf-                       , NoImplicitPrelude-                       , RecordWildCards-                       , TupleSections+  exposed-modules:      Hydrogen.Data+  build-depends:        base ==4.7.*+                        , hydrogen-prelude ==0.12+                        , hydrogen-parsing ==0.12+  hs-source-dirs:       src+  ghc-options:          -Wall+  default-language:     Haskell2010+  default-extensions:   CPP+                        , DeriveDataTypeable+                        , DeriveGeneric+                        , FlexibleInstances+                        , GADTs+                        , LambdaCase+                        , NoImplicitPrelude

@@ -1,71 +1,138 @@ module Hydrogen.Data (-    emptyNode-  , parseData-  , loadData-  , merge-  , Data-  , isNode+    Value+  , MkValue (..)+  , mkLink+  , readValue+  , isInteger   , isNumber-  , isString   , isVersion   , isUUID-  , isBool   , isDateTime   , isDate   , isTime   , isLink-  , isConstant-  , getNodeMap-  , getNodeList+  , isNull+  , isNotANumber+  , isPositive+  , isZero+  , isNegative+  , isNonNegative   , getNumber-  , getString   , getVersion   , getUUID-  , getBool   , getDateTime   , getDate   , getTime   , getLink-  , getConstant+  , getInteger   ) where  import Hydrogen.Prelude hiding (isNumber)+import Hydrogen.Parsing hiding (parse) -import Hydrogen.Syntax.Parser-import Hydrogen.Data.Parser-import Hydrogen.Data.Types+import qualified Data.Version -import Hydrogen.Parsing hiding (parse)+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) -import qualified Data.Map as Map+instance Serialize Value -merge :: Data -> Data -> Data-merge d1 d2 = case (d1, d2) of-    (DNode m1 l1, DNode m2 l2) -> DNode (Map.unionWith merge m1 m2) (l1 ++ l2)-    (_, dx) -> dx -emptyNode :: Data-emptyNode = DNode Map.empty []+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+  ] -loadData :: FilePath -> IO (Either SomethingBad Data)-loadData fp = (parseData <+< parse fp) <$> readFile fp+class MkValue a where mkValue :: a -> Value -isNode, isNumber, isString, isVersion, isUUID, isBool,-  isDateTime, isDate, isTime, isLink, isConstant-    :: Data -> Bool+instance MkValue Int where+    mkValue = DNumber . fromIntegral -isNode = \case-    DNode _ _ -> True+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 -isNumber = \case-    DNumber _ -> True+isZero = \case+    DNumber r -> numerator r == 0     _ -> False -isString = \case-    DString _ -> True+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@@ -74,10 +141,6 @@     DUUID _ -> True     _ -> False -isBool = \case-    DBool _ -> True-    _ -> False- isDateTime = \case     DDateTime _ -> True     _ -> False@@ -94,67 +157,53 @@     DLink _ -> True     _ -> False -isConstant = \case-    DConstant _ -> True+isNull = \case+    DNull -> True     _ -> False -getNodeMap :: Data -> Map String Data-getNodeMap = \case-    DNode keyValueMap _ -> keyValueMap-    _ -> Map.empty+isNotANumber = \case+    DNotANumber -> True+    _ -> False -getNodeList :: Data -> [Data]-getNodeList = \case-    DNode _ xs -> xs-    _ -> [] -getNumber :: Monad m => Data -> m Rational+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 DNumber"--getString :: Monad m => Data -> m String-getString = \case-    DString r -> return r-    _ -> fail "not a DString"+    _ -> fail "not a Number" -getVersion :: Monad m => Data -> m Version+getVersion :: Monad m => Value -> m Version getVersion = \case     DVersion v -> return v-    _ -> fail "not a DVersion"+    _ -> fail "not a Version" -getUUID :: Monad m => Data -> m UUID+getUUID :: Monad m => Value -> m UUID getUUID = \case     DUUID u -> return u-    _ -> fail "not a DUUID"--getBool :: Monad m => Data -> m Bool-getBool = \case-    DBool b -> return b-    _ -> fail "not a DBool"+    _ -> fail "not a UUID" -getDateTime :: Monad m => Data -> m ZonedTime+getDateTime :: Monad m => Value -> m ZonedTime getDateTime = \case     DDateTime d -> return d-    _ -> fail "not a DDateTime"+    _ -> fail "not a DateTime" -getDate :: Monad m => Data -> m Day+getDate :: Monad m => Value -> m Day getDate = \case     DDate d -> return d-    _ -> fail "not a DDate"+    _ -> fail "not a Date" -getTime :: Monad m => Data -> m TimeOfDay+getTime :: Monad m => Value -> m TimeOfDay getTime = \case     DTime d -> return d-    _ -> fail "not a DTime"+    _ -> fail "not a Time" -getLink :: Monad m => Data -> m String+getLink :: Monad m => Value -> m String getLink = \case     DLink l -> return l-    _ -> fail "not a DLink"+    _ -> fail "not a Link" -getConstant :: Monad m => Data -> m String-getConstant = \case-    DConstant c -> return c-    _ -> fail "not a DConstant" 

@@ -1,83 +0,0 @@-module Hydrogen.Data.Parser where--import Hydrogen.Prelude hiding (left, many, right, (<|>))-import Hydrogen.Data.Types--import Hydrogen.Syntax.Types--import Hydrogen.Parsing--import qualified Data.Map as Map---parseData :: Parser POPs Data-parseData = either mkError Right . runIdentity . runParserT items () ""--items :: Monad m => ParsecT POPs u m Data-items = do--    let left  = Left <$> (keyValue <|> node)-        right = Right <$> value--    (keyValues, values) <- partitionEithers <$> sepBy (left <|> right) separator-    -    return (DNode (Map.fromList keyValues) values)--value :: Monad m => ParsecT POPs u m Data-value = val <|> link <|> (DConstant <$> matches "^[A-Z](_?[A-Z0-9])*$")-  where-      val = sourceToken $ \case-        Token AposString "" xs -> Just (DString xs)-        Token QuotString "" xs -> Just (DString xs)-        Token SomethingT "" xs -> firstJust [-            fmap DNumber . tryReadDecimal-          , fmap DNumber . tryReadRational-          , fmap DNumber . tryReadHex-          , fmap DBool . tryReadBool-          , fmap DVersion . tryReadVersion-          , fmap DUUID . tryReadUUID-          , fmap DDateTime . join . tryReadDateTime-          , fmap DDate . join . tryReadDate-          , fmap DTime . join . tryReadTime-          ] xs-        _ -> Nothing--link :: (Monad m) => ParsecT POPs u m Data-link = DLink <$> matches url-  where-    url = concat [-        "^[a-z](-?[a-z0-9])*(\\.[a-z](-?[a-z0-9])*)+"-      , "(/([a-z0-9_.=-]|%[a-fA-F0-9]{2}|%u[a-fA-F0-9]{4})*)+"-      , "(\\?([a-z0-9_.=-]|%[a-fA-F0-9]{2}|%u[a-fA-F0-9]{4})*)?$"-      ]--keyValue :: Monad m => ParsecT [(SourcePos, POP)] u m (String, Data)-keyValue = liftA2 (,) (init <$> matches "^[a-z](\\-?[a-z0-9])*:$") value--node :: Monad m => ParsecT [(SourcePos, POP)] u m (String, Data)-node = sourceToken $ \case-    Block Mustache key pops | not (null key) -> (key ,) <$> dataNode pops-    _ -> Nothing-  where-    dataNode :: POPs -> Maybe Data-    dataNode = either (const Nothing) Just . runIdentity . runParserT items () "-"--separator :: Monad m => ParsecT POPs u m String-separator = equals ";;" <|> equals ";"--noSeparator :: Monad m => ParsecT POPs u m POP-noSeparator = sourceToken $ \case-    Token SomethingT "" val | elem val [";;", ";"] -> Nothing-    t -> Just t--equals, matches :: Monad m => String -> ParsecT POPs u m String--equals string = sourceToken $ \case-    Token SomethingT "" val | val == string -> Just val-    _ -> Nothing--matches regex = sourceToken $ \case-    Token SomethingT "" val | val =~ regex -> Just val-    _ -> Nothing--

@@ -1,78 +0,0 @@-{-# OPTIONS_GHC -fno-warn-name-shadowing #-}--module Hydrogen.Data.Types where--import Hydrogen.Prelude--import qualified Data.Map as Map--data Data where-    DNode :: Map String Data -> [Data] -> Data-    DNumber :: Rational -> Data-    DString :: String -> Data-    DVersion :: Version -> Data-    DUUID :: UUID -> Data-    DBool :: Bool -> Data-    DDateTime :: ZonedTime -> Data-    DDate :: Day -> Data-    DTime :: TimeOfDay -> Data-    DLink :: String -> Data-    DConstant :: String -> Data-  deriving (Eq, Generic, Typeable)--instance Serialize Data--showsDNode :: String -> Data -> ShowS-showsDNode pfx node xs = case node of--    DNode obj ds -> Map.foldrWithKey showsKeyValue xs' obj-      where-        showsKeyValue key = \case-            val@(DNode _ _) -> (printf "\n%s%s{" pfx key ++)-                . showsDNode pfx' val . (printf "\n%s}" pfx ++)-            val -> (printf "\n%s%s: " pfx key ++) . showsDNode pfx' val--        pfx' = "  " ++ pfx-        xs' = foldr showsValue xs ds-        showsValue val = (('\n':pfx) ++) . shows val--    d -> shows d xs---instance Show Data where--    showsPrec _ = \case--        d@(DNode obj ds) -> if Map.null obj && null ds then id else tail . showsDNode "" d--        DNumber rat -> -            if | denom == 1 -> (show num ++)-               | otherwise -> (printf "%d/%d" num denom ++)-          where-            (num, denom) = (numerator rat, denominator rat)--        DString str -> shows str--        DVersion ver -> ('v' :) . shows ver--        DUUID uuid -> shows uuid--        DBool val -> (bool "TRUE" "FALSE" val ++)--        DDateTime date -> shows localDay . ('T' :) . shows localTimeOfDay . showTimeZone-          where-            LocalTime { .. } = zonedTimeToLocalTime date-            offset = timeZoneMinutes (zonedTimeZone date)-            (hours, minutes) = quotRem offset 60-            showTimeZone = case offset of-                0 -> ('Z' :)-                _ -> (printf "%+02d:%02d" hours minutes ++)--        DDate day -> shows day--        DTime time -> shows time--        DLink link -> (link ++)--        DConstant s -> (s ++)-