packages feed

hydrogen-data (empty) → 0.5

raw patch · 7 files changed

+294/−0 lines, 7 filesdep +basedep +containersdep +hydrogen-preludesetup-changed

Dependencies added: base, containers, hydrogen-prelude, hydrogen-syntax, hydrogen-util, nicify, parsec, uuid

Files

+ CHANGELOG.md view
+ LICENSE view
@@ -0,0 +1,19 @@+Copyright (c) 2014 Julian Fleischer++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in+all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN+THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ hydrogen-data.cabal view
@@ -0,0 +1,41 @@+name:                 hydrogen-data+version:              0.5+homepage:             https://github.com/scravy/hydrogen-data+synopsis:             Hydrogen Data+license:              BSD3+license-file:         LICENSE+extra-source-files:   CHANGELOG.md+author:               Julian Fleischer+maintainer:           julfleischer@paypal.com+category:             Language+build-type:           Simple+cabal-version:        >=1.18++source-repository head+    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.5+                      , hydrogen-syntax ==0.5+                      , hydrogen-util ==0.5+                      , nicify ==1.1.*+                      , parsec ==3.1.*+                      , uuid ==1.3.*+  hs-source-dirs:     src+  ghc-options:        -Wall+  default-language:   Haskell2010+  default-extensions:  CPP+                       , EmptyCase+                       , FlexibleContexts+                       , GADTs+                       , LambdaCase+                       , MultiWayIf+                       , NoImplicitPrelude+                       , RecordWildCards+                       , TupleSections
+ src/Hydrogen/Data.hs view
@@ -0,0 +1,30 @@+module Hydrogen.Data (+    emptyNode+  , loadData+  , loadData'+  , merge+  , Data+  ) where++import Hydrogen.Prelude++import Hydrogen.Syntax.Parser+import Hydrogen.Data.Parser+import Hydrogen.Data.Types++import Hydrogen.Util.Parsec hiding (parse)++import qualified Data.Map as Map++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 []++loadData :: FilePath -> IO (Either SomethingBad Data)+loadData fp = (parseData <+< parse fp) <$> readFile fp++
+ src/Hydrogen/Data/Parser.hs view
@@ -0,0 +1,97 @@+module Hydrogen.Data.Parser where++import Hydrogen.Prelude hiding (left, many, right, (<|>))+import Hydrogen.Data.Types++import Hydrogen.Syntax.Types++import Hydrogen.Util.Parsec+import Hydrogen.Util.Read++import qualified Data.Map as Map+++parseData :: Parser POPs Data+parseData = either mkError Right . runIdentity . runParserT items () "-"++parseData' :: Parser POPs Document+parseData' = either mkError Right . runIdentity . runParserT items' () "-"++items' :: Monad m => ParsecT POPs u m Document+items' = do++    let left  = Left <$> (keyValue <|> node)+        right = Right <$> many (liftM2 (,) getPosition noSeparator)++    (keyValues, pops) <- partitionEithers <$> sepBy (left <|> right) separator++    return (Document (DNode (Map.fromList keyValues) []) pops)++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++
+ src/Hydrogen/Data/Types.hs view
@@ -0,0 +1,105 @@+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}++module Hydrogen.Data.Types where++import Hydrogen.Prelude+import Hydrogen.Prelude.Extra++import Hydrogen.Syntax.Types++import Text.Parsec.Pos++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)++data Document = Document Data [POPs]++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 ++)+++instance Show Document where++    showsPrec _ (Document props pops) = \xs ->+        "Properties:" ++ showsDNode "  " props ("\n\n" ++ showPopss pops xs)++      where+        showPopss pops xs = concatMap showPops pops ++ xs++        showPops pops = concatMap (\(a, b) -> printf "%s%s\n" (showPos a) (showTok "         " b)) pops ++ "\n"++        showPos :: SourcePos -> String+        showPos pos = printf "%3d%3d " (sourceLine pos) (sourceColumn pos)++        showTok :: String -> POP -> String+        showTok pfx = \case+            Token t k s -> printf "%s %s %s" (show t) k (show s)+            Block t k ts -> printf "%s %s %s" (show t) k (concatMap (\t -> '\n' : pfx' ++ showTok pfx' (snd t)) ts)+          where+            pfx' = "  " ++ pfx++