hedn (empty) → 0.1.3.0
raw patch · 9 files changed
+631/−0 lines, 9 filesdep +ansi-terminaldep +attoparsecdep +basesetup-changed
Dependencies added: ansi-terminal, attoparsec, base, bytestring, containers, hedn, stringsearch, text, vector
Files
- LICENSE +30/−0
- Setup.hs +2/−0
- hedn.cabal +56/−0
- src/Data/EDN.hs +17/−0
- src/Data/EDN/Encode.hs +89/−0
- src/Data/EDN/Parser.hs +229/−0
- src/Data/EDN/Types.hs +74/−0
- tests/TestEncoder.hs +9/−0
- tests/TestParser.hs +125/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2012, Alexander Bondarenko++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Alexander Bondarenko nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ hedn.cabal view
@@ -0,0 +1,56 @@+-- Initial hedn.cabal generated by cabal init. For further documentation, +-- see http://haskell.org/cabal/users-guide/++name: hedn+version: 0.1.3.0+synopsis: EDN parsing and encoding+homepage: https://bitbucket.org/dpwiz/hedn+license: BSD3+license-file: LICENSE+author: Alexander Bondarenko+maintainer: aenor.realm@gmail.com+copyright: (c) 2012 Alexander Bondarenko+category: Data+build-type: Simple+cabal-version: >=1.8+description:+ A EDN parsing and encoding library inspired by Data.Aeson.+ .+ Based on specs published at <https://github.com/edn-format/edn>.++extra-source-files:+ tests/TestParser.hs+ tests/TestEncoder.hs++flag developer+ description: operate in developer mode+ default: False++library+ exposed-modules: Data.EDN, Data.EDN.Types, Data.EDN.Parser, Data.EDN.Encode+ hs-source-dirs: src/+ build-depends: base ==4.5.*, attoparsec, text, bytestring, containers, vector, stringsearch++ if flag(developer)+ ghc-options: -Werror+ ghc-prof-options: -auto-all++ ghc-options: -O2 -Wall -fno-warn-unused-do-bind+++Test-Suite test-parser+ type: exitcode-stdio-1.0+ main-is: TestParser.hs+ hs-source-dirs: tests/+ build-depends: base, hedn, attoparsec, bytestring, ansi-terminal+ ghc-options: -Wall++Test-Suite test-encoder+ type: exitcode-stdio-1.0+ main-is: TestEncoder.hs+ hs-source-dirs: tests/+ build-depends: base, hedn, attoparsec, bytestring, ansi-terminal++source-repository head+ type: mercurial+ location: https://bitbucket.org/dpwiz/hedn
+ src/Data/EDN.hs view
@@ -0,0 +1,17 @@+module Data.EDN (+ -- * Core EDN types+ Value(..), TaggedValue(..),++ -- * Constructors+ makeVec, makeSet, makeMap,++ -- * Encoding+ encode, fromValue, fromTagged,++ -- * Parsing+ decode, parseValue, parseTagged+) where++import Data.EDN.Types (Value(..), TaggedValue(..), makeVec, makeSet, makeMap)+import Data.EDN.Encode (encode, fromValue, fromTagged)+import Data.EDN.Parser (decode, parseValue, parseTagged)
+ src/Data/EDN/Encode.hs view
@@ -0,0 +1,89 @@+{-# LANGUAGE OverloadedStrings #-}++module Data.EDN.Encode (fromValue, fromTagged, encode) where++import Data.Monoid (mappend)+import qualified Data.Text as T+import Data.Text.Lazy.Builder+import Data.Text.Lazy.Builder.Int (decimal)+import Data.Text.Lazy.Builder.RealFloat (realFloat)+import Data.Text.Lazy.Encoding (encodeUtf8, decodeUtf8)+import qualified Data.ByteString.Char8 as BS+import qualified Data.ByteString.Lazy as L++import qualified Data.Vector as V+import qualified Data.Map as M+import qualified Data.Set as S++import qualified Data.EDN.Types as E++-- | Encode a Tagged EDN value to a 'Builder'.+fromTagged :: E.TaggedValue -> Builder+fromTagged (E.NoTag v) = fromValue v+fromTagged (E.Tagged v "" t) = singleton '#' <> string t <> singleton ' ' <> fromValue v+fromTagged (E.Tagged v ns t) = singleton '#' <> string ns <> singleton '/' <> string t <> singleton ' ' <> fromValue v++-- | Encode a raw EDN value to a 'Builder'.+fromValue :: E.Value -> Builder++fromValue E.Nil = "nil"++fromValue (E.Boolean b) = if b then "true" else "false"++fromValue (E.String t) = singleton '"' <> quote t <> singleton '"'++fromValue (E.Character c) = singleton '\\' <> singleton c++fromValue (E.Symbol "" v) = string v+fromValue (E.Symbol ns v) = string ns <> singleton '/' <> string v++fromValue (E.Keyword kw) = singleton ':' <> string kw++fromValue (E.Integer i) = decimal i++fromValue (E.Floating f) = realFloat f++fromValue (E.List xs) = singleton '(' <> fromList xs <> singleton ')'++fromValue (E.Vec xs) = singleton '[' <> fromList (V.toList xs) <> singleton ']'++fromValue (E.Set xs) = "#{" <> fromList (S.toList xs) <> singleton '}'++fromValue (E.Map as) = singleton '{' <> fromAssoc (M.assocs as) <> singleton '}'++string :: BS.ByteString -> Builder+string s = fromLazyText . decodeUtf8 . L.fromChunks $ [s]++quote :: T.Text -> Builder+quote q = case T.uncons t of+ Nothing -> fromText h+ Just (c, t') -> fromText h <> escape c <> quote t'+ where+ (h, t) = T.break isEscape q+ isEscape c = c == '\"' || c == '\\' || c < '\x20'+ escape '\"' = "\\\""+ escape '\\' = "\\\\"+ escape '\n' = "\\n"+ escape '\r' = "\\r"+ escape '\t' = "\\t"+ escape c = singleton c++fromList :: [E.TaggedValue] -> Builder+fromList [] = ""+fromList (x:[]) = fromTagged x+fromList (x:xs) = fromTagged x <> singleton ' ' <> fromList xs++fromAssoc :: [(E.Value, E.TaggedValue)] -> Builder+fromAssoc [] = ""+fromAssoc ((k, v):[]) = fromValue k <> singleton ' ' <> fromTagged v+fromAssoc ((k, v):as) = fromValue k <> singleton ' ' <> fromTagged v <> singleton ' ' <> fromAssoc as++-- | Serialize a EDN value as a lazy 'L.ByteString'.+encode :: E.TaggedValue -> L.ByteString+encode = encodeUtf8 . toLazyText . fromTagged+{-# INLINE encode #-}++(<>) :: Builder -> Builder -> Builder+(<>) = mappend+{-# INLINE (<>) #-}+infixr 6 <>
+ src/Data/EDN/Parser.hs view
@@ -0,0 +1,229 @@+{-# LANGUAGE OverloadedStrings #-}++module Data.EDN.Parser (+ -- * Data parsers+ decode, parseBSL, parseBS, parseT, parseTL, parseS,+ -- * Attoparsec implementation+ parseValue, parseTagged+) where++import Prelude hiding (String, takeWhile)+import Data.Attoparsec.Char8 as A+import qualified Data.Attoparsec.Lazy as AL+import Data.Attoparsec.Combinator()+import Control.Applicative (pure, (<|>), (*>))+import qualified Data.ByteString.Char8 as BS+import qualified Data.ByteString.Lazy.Char8 as BSL+import qualified Data.Text as T+import qualified Data.Text.Encoding as TE+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Encoding as TLE+import Data.ByteString.Search (replace)++import Data.EDN.Types++isSpaceOrComma :: Char -> Bool+isSpaceOrComma ' ' = True+isSpaceOrComma '\r' = True+isSpaceOrComma '\n' = True+isSpaceOrComma '\t' = True+isSpaceOrComma ',' = True+isSpaceOrComma _ = False++spaceOrComma :: Parser Char+spaceOrComma = satisfy isSpaceOrComma <?> "space/comma"++skipSoC :: Parser ()+skipSoC = skipWhile isSpaceOrComma++parseNil :: Parser Value+parseNil = do+ skipSoC+ string "nil"+ return Nil++parseBool :: Parser Value+parseBool = do+ skipSoC+ choice [ string "true" *> pure (Boolean True)+ , string "false" *> pure (Boolean False)+ ]++parseString :: Parser Value+parseString = do+ skipSoC+ char '"'++ x <- A.scan False $ \s c -> if s then Just False+ else if c == '"'+ then Nothing+ else Just (c == '\\')+ char '"'++ if '\\' `BS.elem` x+ then return $! String . TE.decodeUtf8 . rep "\\\"" "\"". rep "\\\\" "\\" . rep "\\n" "\n" . rep "\\r" "\r" . rep "\\t" "\t" $ x+ else return $! String . TE.decodeUtf8 $ x++ where rep f t s = BS.concat . BSL.toChunks $! replace (BS.pack f) (BS.pack t) s++parseCharacter :: Parser Value+parseCharacter = do+ skipSoC+ char '\\'+ x <- string "newline" <|> string "space" <|> string "tab" <|> A.take 1+ return . Character $! case x of+ "newline" -> '\n'+ "space" -> ' '+ "tab" -> '\t'+ _ -> BS.head x++parseSymbol :: Parser Value+parseSymbol = do+ skipSoC+ c <- satisfy (inClass "a-zA-Z.*/!?+_-")+ (ns, val) <- withNS c <|> withoutNS c+ return $! Symbol ns val+ where+ withNS c = do+ ns <- takeWhile1 (inClass "a-zA-Z0-9#:.*!?+_-")+ char '/'+ val <- takeWhile1 (inClass "a-zA-Z0-9#:.*!?+_-")+ return (c `BS.cons` ns, val)++ withoutNS c = do+ val <- takeWhile (inClass "a-zA-Z0-9#:.*!?+_-")+ return ("", c `BS.cons` val)++parseKeyword :: Parser Value+parseKeyword = do+ skipSoC+ char ':'+ x <- takeWhile1 (inClass "a-zA-Z0-9.*/!?+_-")+ return $! Keyword x++parseNumber :: Parser Value+parseNumber = do+ skipSoC+ n <- number+ case n of+ I i -> return $! Integer i+ D d -> return $! Floating d++parseList :: Parser Value+parseList = do+ skipSoC+ char '('+ vs <- parseTagged `sepBy` spaceOrComma+ char ')'+ return $! List vs++parseVector :: Parser Value+parseVector = do+ skipSoC+ char '['+ vs <- parseTagged `sepBy` spaceOrComma+ char ']'+ return $! makeVec' vs++parseMap :: Parser Value+parseMap = do+ skipSoC+ char '{'+ pairs <- parseAssoc `sepBy` spaceOrComma+ char '}'+ return $! makeMap' pairs+ where+ parseAssoc = do+ key <- parseValue+ val <- parseTagged+ return (key, val)++parseSet :: Parser Value+parseSet = do+ skipSoC+ char '#'+ char '{'+ vs <- parseTagged `sepBy` spaceOrComma+ char '}'+ return $! makeSet' vs++skipComment :: Parser ()+skipComment = skipSoC >> char ';' >> skipWhile (/= '\n')++parseDiscard :: Parser ()+parseDiscard = do+ skipSoC+ string "#_"+ parseValue+ return ()++-- | Parse a \"raw\" EDN value into a 'Value'.+parseValue :: Parser Value+parseValue = do+ skipSoC+ skipMany skipComment+ skipMany parseDiscard++ parseSet <|> parseMap+ <|> parseVector <|> parseList+ <|> parseNil <|> parseBool+ <|> parseNumber+ <|> parseKeyword <|> parseSymbol+ <|> parseCharacter+ <|> parseString++-- | Parse a probably tagged EDN value into a 'TaggedValue'.+parseTagged :: Parser TaggedValue+parseTagged = do+ skipSoC+ withNS <|> withoutNS <|> noTag+ where+ withNS = do+ char '#'+ ns <- takeWhile1 (inClass "a-zA-Z0-9-")+ char '/'+ tag <- takeWhile1 (inClass "a-zA-Z0-9-")+ value <- parseValue+ return $! Tagged value ns tag++ withoutNS = do+ char '#'+ tag <- takeWhile1 (inClass "a-zA-Z0-9-")+ value <- parseValue+ return $! Tagged value "" tag++ noTag = do+ value <- parseValue+ return $! NoTag value++-- | Decode a lazy 'BSL.ByteString' into a 'TaggedValue'. If fails due to incomplete or invalid input, 'Nothing' is returned.+decode :: BSL.ByteString -> Maybe TaggedValue+decode src = case parseBSL src of+ AL.Done _ r -> Just r+ _ -> Nothing++-- | Parse a lazy 'BSL.ByteString'.+parseBSL :: BSL.ByteString -> AL.Result TaggedValue+parseBSL = AL.parse parseTagged+{-# INLINE parseBSL #-}++-- | Parse a strict 'BS.ByteString', but without continutations.+parseBS :: BS.ByteString -> AL.Result TaggedValue+parseBS s = parseBSL . BSL.fromChunks $ [s]+{-# INLINE parseBS #-}++-- | Parse a lazy 'TL.Text'.+parseTL :: TL.Text -> AL.Result TaggedValue+parseTL = parseBSL . TLE.encodeUtf8+{-# INLINE parseTL #-}++-- | Parse a strict 'T.Text'.+parseT :: T.Text -> AL.Result TaggedValue+parseT = parseBS . TE.encodeUtf8+{-# INLINE parseT #-}++-- | Parse a string AKA '[Char]'. Not really useful other than for debugging purposes.+parseS :: [Char] -> AL.Result TaggedValue+parseS = parseBSL . BSL.pack+{-# INLINE parseS #-}+
+ src/Data/EDN/Types.hs view
@@ -0,0 +1,74 @@+module Data.EDN.Types (+ -- * Types++ TaggedValue(..), Value(..),++ -- * Constructors++ -- ** Empty-tagged containers+ makeList, makeVec, makeSet, makeMap,++ -- ** Tagged containers+ makeVec', makeSet', makeMap'+) where++import Data.Text (Text)+import Data.ByteString.Char8 (ByteString)+import qualified Data.Vector as V+import qualified Data.Map as M+import qualified Data.Set as S++-- | A \"raw\" EDN value represented as a Haskell value.+data Value = Nil+ | Boolean Bool+ | String Text+ | Character Char+ | Symbol ByteString ByteString+ | Keyword ByteString+ | Integer Integer+ | Floating Double+ | List [TaggedValue]+ | Vec (V.Vector TaggedValue)+ | Map (M.Map Value TaggedValue)+ | Set (S.Set TaggedValue)+ deriving (Eq, Ord, Show)++-- | A 'Value' wrapped into a namespaced tag.+data TaggedValue = NoTag Value+ | Tagged Value ByteString ByteString+ deriving (Eq, Ord, Show)++-- | Create an EDN 'List' from a 'Value' list wrapping them into empty tags.+makeList :: [Value] -> Value+makeList = List . map NoTag+{-# INLINE makeList #-}++-- | Create an EDN 'Vector' from a 'TaggedValue' list.+makeVec' :: [TaggedValue] -> Value+makeVec' = Vec . V.fromList+{-# INLINE makeVec' #-}++-- | Create an EDN 'Vector' from a 'Value' list wrapping them into empty tags.+makeVec :: [Value] -> Value+makeVec = makeVec' . map NoTag+{-# INLINE makeVec #-}++-- | Create an EDN 'Set' from a 'TaggedValue' list.+makeSet' :: [TaggedValue] -> Value+makeSet' = Set . S.fromList+{-# INLINE makeSet' #-}++-- | Create an EDN 'Set' from a 'Value' list wrapping them into empty tags.+makeSet :: [Value] -> Value+makeSet = makeSet' . map NoTag+{-# INLINE makeSet #-}++-- | Create an EDN 'Map' from a assoc list with untagged keys and tagged values.+makeMap' :: [(Value, TaggedValue)] -> Value+makeMap' = Map . M.fromList+{-# INLINE makeMap' #-}++-- | Create an EDN 'Map' from a assoc list with untagged keys and values, wrapping values into empty tags.+makeMap :: [(Value, Value)] -> Value+makeMap as = makeMap' [(k, NoTag v) | (k, v) <- as]+{-# INLINE makeMap #-}
+ tests/TestEncoder.hs view
@@ -0,0 +1,9 @@+{-# LANGUAGE OverloadedStrings #-}++module Main where++import Data.EDN.Types as E+import Data.EDN.Encode (encode)++main = do+ print . encode . E.NoTag . E.List $ map E.NoTag [E.Keyword "a", E.Keyword "b", E.Integer 42]
+ tests/TestParser.hs view
@@ -0,0 +1,125 @@+{-# LANGUAGE OverloadedStrings, Rank2Types #-}++module Main where++import Data.Attoparsec.Lazy as A+import qualified Data.ByteString.Lazy.Char8 as BSL++import Data.EDN.Parser as P+import Data.EDN.Types as E++import Control.Monad (forM_)+import qualified System.Console.ANSI as ANSI++main :: IO ()+main = forM_ cases $ checkCase (parse P.parseTagged) (parserResult)++parserResult :: Eq a => Result a -> a -> Bool+parserResult result output = case result of+ Done "" o -> o == output+ _ -> False++checkCase :: forall a a1. (Show a1, Show a) => (BSL.ByteString -> a1)+ -> (a1 -> a -> Bool)+ -> (BSL.ByteString, a)+ -> IO ()+checkCase runner checker (input, output) = do+ putStr "Checking: '"+ BSL.putStr input+ putStrLn "'"++ putStrLn $ "Should be: " ++ show output++ let result = runner input+ let correct = checker result output++ ANSI.setSGR [ANSI.SetColor ANSI.Foreground ANSI.Vivid (if correct then ANSI.Green else ANSI.Red)]+ putStr "Result: "+ ANSI.setSGR [ANSI.Reset]+ print result+ putStrLn ""++cases :: [(BSL.ByteString, E.TaggedValue)]+cases = map (\(i, o) -> (i, E.NoTag o)) noTags ++ haveTags++noTags :: [(BSL.ByteString, E.Value)]+noTags = [ ("nil", Nil)++ , ("true", E.Boolean True)+ , ("false", E.Boolean False)++ , ("\"a nice string\"", E.String "a nice string")+ , ("\"split\\second \\t\\rai\\n\"", E.String "split\\second \t\rai\n")+ , ("\"test \\\"sausage\\\" shmest\"", E.String "test \"sausage\" shmest")+ , ("\"\"", E.String "")++ , ("\\c", E.Character 'c')+ , ("\\\\", E.Character '\\')+ , ("\\newline", E.Character '\n')+ , ("\\space", E.Character ' ')+ , ("\\tab", E.Character '\t')++ , ("justasymbol", E.Symbol "" "justasymbol")+ , ("with#stuff:inside", E.Symbol "" "with#stuff:inside")+ , ("my-namespace/foo", E.Symbol "my-namespace" "foo")+ , ("/", E.Symbol "" "/")++ , (":fred", E.Keyword "fred")+ , (":my/fred", E.Keyword "my/fred")++ , ("42", E.Integer 42)+ , ("-1", E.Integer (-1))++ , ("100.50", E.Floating 100.5)+ , ("-3.14", E.Floating (-3.14))+ -- ...and many other strange stuff...++ , ("(a b 42)", sampleList)+ , ("()", E.List [])++ , ("[a b 42]", sampleVec)+ , ("[]", E.makeVec [])++ , ("{:a 1 \"foo\" :bar [1 2 3] four}", sampleMap)+ , ("{}", E.makeMap [])++ , ("#{a b [1 2 3]}", sampleSet)+ , ("#{}", E.makeSet [])++ , ("[a b #_foo 42]", sampleDiscard)+ , ("(1 2 ;more to go!\n 3 4)", sampleComment)+ ]++haveTags :: [(BSL.ByteString, E.TaggedValue)]+haveTags = [ ("#myapp/Person {:first \"Fred\" :last \"Mertz\"}", E.Tagged sampleTaggedMap "myapp" "Person")+ , ("{:first \"Fred\" :last \"Mertz\"}", E.NoTag sampleTaggedMap)+ ]++sampleList :: E.Value+sampleList = E.makeList [E.Symbol "" "a", E.Symbol "" "b", E.Integer 42]++sampleVec :: E.Value+sampleVec = E.makeVec [E.Symbol "" "a", E.Symbol "" "b", E.Integer 42]++sampleMap :: E.Value+sampleMap = E.makeMap [ (E.Keyword "a", E.Integer 1)+ , (E.String "foo", E.Keyword "bar")+ , (E.makeVec [E.Integer 1, E.Integer 2, E.Integer 3], E.Symbol "" "four")+ ]++sampleSet :: E.Value+sampleSet = E.makeSet [ E.Symbol "" "a"+ , E.Symbol "" "b"+ , E.makeVec [E.Integer 1, E.Integer 2, E.Integer 3]+ ]++sampleDiscard :: E.Value+sampleDiscard = E.makeVec [E.Symbol "" "a", E.Symbol "" "b", E.Integer 42]++sampleComment :: E.Value+sampleComment = E.makeList [E.Integer 1, E.Integer 2, E.Integer 3, E.Integer 4]++sampleTaggedMap :: E.Value+sampleTaggedMap = E.makeMap [ (E.Keyword "first", E.String "Fred")+ , (E.Keyword "last", E.String "Mertz")+ ]