hedn 0.1.3.0 → 0.1.4.1
raw patch · 5 files changed
+220/−109 lines, 5 files
Files
- hedn.cabal +1/−1
- src/Data/EDN.hs +15/−2
- src/Data/EDN/Parser.hs +4/−4
- src/Data/EDN/Types.hs +146/−41
- tests/TestParser.hs +54/−61
hedn.cabal view
@@ -2,7 +2,7 @@ -- see http://haskell.org/cabal/users-guide/ name: hedn-version: 0.1.3.0+version: 0.1.4.1 synopsis: EDN parsing and encoding homepage: https://bitbucket.org/dpwiz/hedn license: BSD3
src/Data/EDN.hs view
@@ -2,9 +2,22 @@ -- * Core EDN types Value(..), TaggedValue(..), + -- * Tag manipulation+ setTag, getTag, stripTag,+ -- * Constructors- makeVec, makeSet, makeMap,+ tag, notag, + -- ** Basic values+ nil,+ bool, true, false,+ char, string,+ symbol, symbolNS, keyword,+ integer, floating,++ -- ** Containers+ makeList, makeVec, makeSet, makeMap, (..=),+ -- * Encoding encode, fromValue, fromTagged, @@ -12,6 +25,6 @@ decode, parseValue, parseTagged ) where -import Data.EDN.Types (Value(..), TaggedValue(..), makeVec, makeSet, makeMap)+import Data.EDN.Types import Data.EDN.Encode (encode, fromValue, fromTagged) import Data.EDN.Parser (decode, parseValue, parseTagged)
src/Data/EDN/Parser.hs view
@@ -20,7 +20,7 @@ import qualified Data.Text.Lazy.Encoding as TLE import Data.ByteString.Search (replace) -import Data.EDN.Types+import Data.EDN.Types (Value(..), TaggedValue(..), makeVec, makeMap, makeSet) isSpaceOrComma :: Char -> Bool isSpaceOrComma ' ' = True@@ -123,7 +123,7 @@ char '[' vs <- parseTagged `sepBy` spaceOrComma char ']'- return $! makeVec' vs+ return $! makeVec vs parseMap :: Parser Value parseMap = do@@ -131,7 +131,7 @@ char '{' pairs <- parseAssoc `sepBy` spaceOrComma char '}'- return $! makeMap' pairs+ return $! makeMap pairs where parseAssoc = do key <- parseValue@@ -145,7 +145,7 @@ char '{' vs <- parseTagged `sepBy` spaceOrComma char '}'- return $! makeSet' vs+ return $! makeSet vs skipComment :: Parser () skipComment = skipSoC >> char ';' >> skipWhile (/= '\n')
src/Data/EDN/Types.hs view
@@ -1,74 +1,179 @@ module Data.EDN.Types ( -- * Types- TaggedValue(..), Value(..), + -- ** Internal containers+ EDNList, EDNVec, EDNSet, EDNMap, Pair,++ -- * Tag manipulation+ setTag, getTag, stripTag,+ -- * Constructors+ tag, notag, - -- ** Empty-tagged containers- makeList, makeVec, makeSet, makeMap,+ -- ** Trivial values+ nil,+ bool, true, false,+ char, string,+ symbol, symbolNS, keyword,+ integer, floating, - -- ** Tagged containers- makeVec', makeSet', makeMap'+ -- ** Containers+ makeList, makeVec, makeSet, makeMap, (..=) ) where +import Data.String (IsString(..)) import Data.Text (Text)+import qualified Data.Text as T import Data.ByteString.Char8 (ByteString)+import qualified Data.ByteString.Char8 as BS import qualified Data.Vector as V import qualified Data.Map as M import qualified Data.Set as S +type EDNList = [TaggedValue]+type EDNVec = V.Vector TaggedValue+type EDNMap = M.Map Value TaggedValue+type EDNSet = S.Set TaggedValue+ -- | 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)+ | Boolean !Bool+ | String !Text+ | Character !Char+ | Symbol !ByteString !ByteString+ | Keyword !ByteString+ | Integer !Integer+ | Floating !Double+ | List EDNList+ | Vec !EDNVec+ | Map !EDNMap+ | Set !EDNSet deriving (Eq, Ord, Show) -- | A 'Value' wrapped into a namespaced tag.-data TaggedValue = NoTag Value- | Tagged Value ByteString ByteString+data TaggedValue = NoTag !Value+ | Tagged !Value !ByteString !ByteString deriving (Eq, Ord, Show) +-- | Strings starting with \":\" will become keywords.+instance IsString Value where+ fromString (':':s) = Keyword . BS.pack $ s+ fromString s = String . T.pack $ s+ {-# INLINE fromString #-}++-- | Strings will become an tagless EDN strings.+instance IsString TaggedValue where+ fromString = string . T.pack+ {-# INLINE fromString #-}++-- | Basic EDN nil.+nil :: TaggedValue+nil = NoTag Nil+{-# INLINE nil #-}++-- | Basic EDN boolean.+bool :: Bool -> TaggedValue+bool = NoTag . Boolean+{-# INLINE bool #-}++-- | Const EDN True.+true :: TaggedValue+true = bool True+{-# INLINE true #-}++-- | Const EDN False.+false :: TaggedValue+false = bool False+{-# INLINE false #-}++-- | Basic EDN character.+char :: Char -> TaggedValue+char = NoTag . Character+{-# INLINE char #-}++-- | Basic EDN string.+string :: Text -> TaggedValue+string = NoTag . String+{-# INLINE string #-}++-- | A namespaced symbol.+symbolNS :: ByteString -> ByteString -> TaggedValue+symbolNS ns value = NoTag $ Symbol ns value+{-# INLINE symbolNS #-}++-- | \"Bare\" symbol.+symbol :: ByteString -> TaggedValue+symbol = symbolNS BS.empty+{-# INLINE symbol #-}++-- | Basic EDN keyword.+keyword :: ByteString -> TaggedValue+keyword = NoTag . Keyword+{-# INLINE keyword #-}++-- | Basic EDN integer.+integer :: Integer -> TaggedValue+integer = NoTag . Integer+{-# INLINE integer #-}++-- | Basic EDN fp number.+floating :: Double -> TaggedValue+floating = NoTag . Floating+{-# INLINE floating #-}++-- | Attach a namespaced tag to a 'Value'.+tag :: ByteString -> ByteString -> Value -> TaggedValue+tag ns t value = Tagged value ns t+{-# INLINE tag #-}++-- | Wrap a 'Value' into tagless container.+notag :: Value -> TaggedValue+notag = NoTag+{-# INLINE notag #-}++-- | Replace a tag on a value.+setTag :: ByteString -> ByteString -> TaggedValue -> TaggedValue+setTag ns t (NoTag v) = tag ns t v+setTag ns t (Tagged v _ _) = tag ns t v+{-# INLINE setTag #-}++-- | Extract namespace and tag from a tagged container. Will be a pair of 'BS.empty' for tagless containers.+getTag :: TaggedValue -> (ByteString, ByteString)+getTag (NoTag _) = (BS.empty, BS.empty)+getTag (Tagged _ ns t) = (ns, t)++-- | Extract bare value from a tagged or tagless container.+stripTag :: TaggedValue -> Value+stripTag (NoTag v) = v+stripTag (Tagged v _ _) = v+{-# INLINE stripTag #-}++ -- | Create an EDN 'List' from a 'Value' list wrapping them into empty tags.-makeList :: [Value] -> Value-makeList = List . map NoTag+makeList :: [TaggedValue] -> Value+makeList = List {-# 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+makeVec :: [TaggedValue] -> Value+makeVec = Vec . V.fromList {-# 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+makeSet :: [TaggedValue] -> Value+makeSet = Set . S.fromList {-# 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' #-}+-- | A key\/value pair for a EDN Map+type Pair = (Value, TaggedValue) --- | 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]+-- | Create an EDN 'Map' from a assoc list with untagged keys and tagged values.+makeMap :: [Pair] -> Value+makeMap = Map . M.fromList {-# INLINE makeMap #-}++-- | Construct a 'Pair' from a key (as EDN keyword) and a value.+(..=) :: ByteString -> TaggedValue -> Pair+name ..= value = (Keyword name, value)+{-# INLINE (..=) #-}
tests/TestParser.hs view
@@ -40,86 +40,79 @@ putStrLn "" cases :: [(BSL.ByteString, E.TaggedValue)]-cases = map (\(i, o) -> (i, E.NoTag o)) noTags ++ haveTags--noTags :: [(BSL.ByteString, E.Value)]-noTags = [ ("nil", Nil)+cases = [ ("nil", E.nil) - , ("true", E.Boolean True)- , ("false", E.Boolean False)+ , ("true", E.true)+ , ("false", E.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 "")+ , ("\"a nice string\"", "a nice string")+ , ("\"split\\second \\t\\rai\\n\"", "split\\second \t\rai\n")+ , ("\"test \\\"sausage\\\" shmest\"", "test \"sausage\" shmest")+ , ("\"\"", "") - , ("\\c", E.Character 'c')- , ("\\\\", E.Character '\\')- , ("\\newline", E.Character '\n')- , ("\\space", E.Character ' ')- , ("\\tab", E.Character '\t')+ , ("\\c", E.char 'c')+ , ("\\\\", E.char '\\')+ , ("\\newline", E.char '\n')+ , ("\\space", E.char ' ')+ , ("\\tab", E.char '\t') - , ("justasymbol", E.Symbol "" "justasymbol")- , ("with#stuff:inside", E.Symbol "" "with#stuff:inside")- , ("my-namespace/foo", E.Symbol "my-namespace" "foo")- , ("/", E.Symbol "" "/")+ , ("justasymbol", E.symbol "justasymbol")+ , ("with#stuff:inside", E.symbol "with#stuff:inside")+ , ("my-namespace/foo", E.symbolNS "my-namespace" "foo")+ , ("/", E.symbol "/") - , (":fred", E.Keyword "fred")- , (":my/fred", E.Keyword "my/fred")+ , (":fred", E.keyword "fred")+ , (":my/fred", E.keyword "my/fred") - , ("42", E.Integer 42)- , ("-1", E.Integer (-1))+ , ("42", E.integer 42)+ , ("-1", E.integer (-1)) - , ("100.50", E.Floating 100.5)- , ("-3.14", E.Floating (-3.14))+ , ("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)", sampleList)+ , ("()", E.notag $ E.makeList []) - , ("[a b 42]", sampleVec)- , ("[]", E.makeVec [])+ , ("[a b 42]", sampleVec)+ , ("[]", E.notag $ E.makeVec []) - , ("{:a 1 \"foo\" :bar [1 2 3] four}", sampleMap)- , ("{}", E.makeMap [])+ , ("{:a 1, \"foo\" :bar, [1 2 3] four}", sampleMap)+ , ("{}", E.notag $ E.makeMap []) - , ("#{a b [1 2 3]}", sampleSet)- , ("#{}", E.makeSet [])+ , ("#{a b [1 2 3]}", sampleSet)+ , ("#{}", E.notag $ E.makeSet []) - , ("[a b #_foo 42]", sampleDiscard)- , ("(1 2 ;more to go!\n 3 4)", sampleComment)- ]+ , ("[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)- ]+ , ("#myapp/Person {:first \"Fred\" :last \"Mertz\"}", E.tag "myapp" "Person" sampleTaggedMap)+ , ("{:first \"Fred\" :last \"Mertz\"}", E.notag sampleTaggedMap)+ ] -sampleList :: E.Value-sampleList = E.makeList [E.Symbol "" "a", E.Symbol "" "b", E.Integer 42]+sampleList :: E.TaggedValue+sampleList = E.notag $ 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]+sampleVec :: E.TaggedValue+sampleVec = E.notag $ 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")- ]+sampleMap :: E.TaggedValue+sampleMap = E.notag $ E.makeMap [ (":a", E.integer 1)+ , ("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]- ]+sampleSet :: E.TaggedValue+sampleSet = E.notag $ E.makeSet [ E.symbol "a"+ , E.symbol "b"+ , E.notag $ 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]+sampleDiscard :: E.TaggedValue+sampleDiscard = E.notag $ 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]+sampleComment :: E.TaggedValue+sampleComment = E.notag $ 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")- ]+sampleTaggedMap = E.makeMap [ "first" ..= "Fred", "last" ..= "Mertz" ]