hedn 0.1.5.0 → 0.1.5.1
raw patch · 8 files changed
+278/−166 lines, 8 filesdep +HUnitdep −ansi-terminaldep ~base
Dependencies added: HUnit
Dependencies removed: ansi-terminal
Dependency ranges changed: base
Files
- hedn.cabal +6/−13
- src/Data/EDN.hs +5/−4
- src/Data/EDN/Encode.hs +8/−1
- src/Data/EDN/Types.hs +11/−11
- src/Data/EDN/Types/Class.hs +39/−10
- tests/Main.hs +209/−0
- tests/TestEncoder.hs +0/−9
- tests/TestParser.hs +0/−118
hedn.cabal view
@@ -2,7 +2,7 @@ -- see http://haskell.org/cabal/users-guide/ name: hedn-version: 0.1.5.0+version: 0.1.5.1 synopsis: EDN parsing and encoding homepage: https://bitbucket.org/dpwiz/hedn license: BSD3@@ -19,8 +19,7 @@ Based on specs published at <https://github.com/edn-format/edn>. extra-source-files:- tests/TestParser.hs- tests/TestEncoder.hs+ tests/Main.hs flag developer description: operate in developer mode@@ -30,7 +29,7 @@ exposed-modules: Data.EDN, Data.EDN.Types, Data.EDN.Parser, Data.EDN.Encode other-modules: Data.Parser, Data.EDN.Types.Class hs-source-dirs: src/- build-depends: base ==4.5.*, attoparsec, text, bytestring, containers, vector, stringsearch, mtl, deepseq+ build-depends: base ==4.*, attoparsec, text, bytestring, containers, vector, stringsearch, mtl, deepseq if flag(developer) ghc-options: -Werror@@ -39,18 +38,12 @@ ghc-options: -O2 -Wall -fno-warn-unused-do-bind -Test-Suite test-parser+Test-Suite tests type: exitcode-stdio-1.0- main-is: TestParser.hs+ main-is: Main.hs hs-source-dirs: tests/- build-depends: base, hedn, attoparsec, bytestring, ansi-terminal+ build-depends: base, hedn, HUnit, bytestring, text, containers, vector 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
src/Data/EDN.hs view
@@ -3,7 +3,7 @@ Value(..), TaggedValue, Tagged(..), -- ** Type conversion- ToEDN, FromEDN, toEDN, fromEDN, fromEDNv,+ ToEDN, FromEDN, toEDN, fromEDN, fromEDNv, (.:), (.:?), -- * Tag manipulation setTag, getTag, stripTag,@@ -19,16 +19,17 @@ integer, floating, -- ** Containers- makeList, makeVec, makeSet, makeMap, (..=),+ makeList, makeVec, makeSet, makeMap, (.=), -- * Encoding encode, fromValue, fromTagged, -- * Parsing- decode, parseValue, parseTagged+ decode, parseValue, parseTagged, Result(..) ) where import Data.EDN.Types-import Data.EDN.Types.Class (FromEDN, ToEDN, toEDN, fromEDN, fromEDNv)+import Data.EDN.Types.Class (FromEDN, ToEDN, toEDN, fromEDN, fromEDNv, (.:), (.:?)) import Data.EDN.Encode (encode, fromValue, fromTagged) import Data.EDN.Parser (decode, parseValue, parseTagged)+import Data.Parser (Result(..))
src/Data/EDN/Encode.hs view
@@ -32,7 +32,7 @@ fromValue (E.String t) = singleton '"' <> quote t <> singleton '"' -fromValue (E.Character c) = singleton '\\' <> singleton c+fromValue (E.Character c) = singleton '\\' <> quoteChar c fromValue (E.Symbol "" v) = string v fromValue (E.Symbol ns v) = string ns <> singleton '/' <> string v@@ -67,6 +67,13 @@ escape '\r' = "\\r" escape '\t' = "\\t" escape c = singleton c++quoteChar :: Char -> Builder+quoteChar c = case c of+ '\n' -> string "newline"+ '\t' -> string "tab"+ ' ' -> string "space"+ _ -> singleton c fromList :: [E.TaggedValue] -> Builder fromList [] = ""
src/Data/EDN/Types.hs view
@@ -21,7 +21,7 @@ integer, floating, -- ** Containers- makeList, makeVec, makeSet, makeMap, (..=)+ makeList, makeVec, makeSet, makeMap, (.=) ) where import Data.String (IsString(..))@@ -126,18 +126,18 @@ floating = NoTag . Floating {-# INLINE floating #-} --- | Attach a namespaced tag to a 'Value'.-tag :: ByteString -> ByteString -> Value -> TaggedValue+-- | Attach a namespaced tag to a value.+tag :: ByteString -> ByteString -> a -> Tagged a tag ns t value = Tagged value ns t {-# INLINE tag #-} --- | Wrap a 'Value' into tagless container.-notag :: Value -> TaggedValue+-- | Wrap a value into tagless container.+notag :: a -> Tagged a notag = NoTag {-# INLINE notag #-} --- | Replace a tag on a value.-setTag :: ByteString -> ByteString -> TaggedValue -> TaggedValue+-- | Replace a tag on a 'Tagged' value.+setTag :: ByteString -> ByteString -> Tagged a -> Tagged a setTag ns t (NoTag v) = tag ns t v setTag ns t (Tagged v _ _) = tag ns t v {-# INLINE setTag #-}@@ -148,7 +148,7 @@ getTag (Tagged _ ns t) = (ns, t) -- | Extract bare value from a tagged or tagless container.-stripTag :: TaggedValue -> Value+stripTag :: Tagged a -> a stripTag (NoTag v) = v stripTag (Tagged v _ _) = v {-# INLINE stripTag #-}@@ -178,6 +178,6 @@ {-# INLINE makeMap #-} -- | Construct a 'Pair' from a key (as EDN keyword) and a value.-(..=) :: ByteString -> TaggedValue -> Pair-name ..= value = (Keyword name, value)-{-# INLINE (..=) #-}+(.=) :: ByteString -> TaggedValue -> Pair+name .= value = (Keyword name, value)+{-# INLINE (.=) #-}
src/Data/EDN/Types/Class.hs view
@@ -1,10 +1,11 @@ {-# LANGUAGE OverloadedStrings, FlexibleInstances, IncoherentInstances #-} module Data.EDN.Types.Class (- ToEDN, FromEDN, toEDN, fromEDN, fromEDNv+ ToEDN, FromEDN, toEDN, fromEDN, fromEDNv, (.:), (.:?) ) where import Control.Applicative (pure, (<$>))+import Control.Monad (liftM, liftM2) import qualified Data.Text as T import qualified Data.Text.Lazy as TL import qualified Data.Text.Encoding as TE@@ -58,6 +59,16 @@ parseEDN (E.NoTag _) = fail "no tag" {-# INLINE parseEDN #-} +instance (ToEDN a) => ToEDN (E.Tagged a) where+ toEDN (E.Tagged v ns t) = E.setTag ns t $ toEDN v+ toEDN (E.NoTag v) = toEDN v+ {-# INLINE toEDN #-}++instance (FromEDN a) => FromEDN (E.Tagged a) where+ parseEDN (E.Tagged v ns t) = E.tag ns t <$> parseEDNv v+ parseEDN (E.NoTag v) = E.notag <$> parseEDNv v+ {-# INLINE parseEDN #-}+ instance ToEDN Bool where toEDN = E.bool {-# INLINE toEDN #-}@@ -209,6 +220,32 @@ fromEDNv = P.parse parseEDNv {-# INLINE fromEDNv #-} +-- | Retrieve the value associated with the given key of an 'E.EDNMap'.+-- The result is 'empty' if the key is not present or the value cannot+-- be converted to the desired type.+--+-- This accessor is appropriate if the key and value /must/ be present+-- in an object for it to be valid. If the key and value are+-- optional, use '(.:?)' instead.+(.:) :: (Show k, ToEDN k, FromEDN a) => E.EDNMap -> k -> P.Parser a+emap .: key = case M.lookup (toEDNv key) emap of+ Nothing -> fail $ "key " ++ show key ++ " not present"+ Just v -> parseEDN v+{-# INLINE (.:) #-}++-- | Retrieve the value associated with the given key of an 'E.EDNMap'.+-- The result is 'Nothing' if the key is not present, or 'empty' if+-- the value cannot be converted to the desired type.+--+-- This accessor is most useful if the key and value can be absent+-- from an object without affecting its validity. If the key and+-- value are mandatory, use '(.:)' instead.+(.:?) :: (ToEDN k, FromEDN a) => E.EDNMap -> k -> P.Parser (Maybe a)+emap .:? key = case M.lookup (toEDNv key) emap of+ Nothing -> pure Nothing+ Just v -> parseEDN v+{-# INLINE (.:?) #-}+ -- | Fail parsing due to a type mismatch, with a descriptive message. typeMismatch :: String -- ^ The name of the type you are trying to parse. -> E.Value -- ^ The actual value encountered.@@ -236,13 +273,5 @@ {-# INLINE mapMset #-} mapMmap :: (Ord a2, Monad m) => (a1 -> m a2) -> (b1 -> m b2) -> M.Map a1 b1 -> m (M.Map a2 b2)-mapMmap kf vf m = do- let pairsIn = M.assocs m- pairsOut <- mapM fs pairsIn- return $! M.fromList pairsOut- where- fs (k, v) = do- newK <- kf k- newV <- vf v- return (newK, newV)+mapMmap kf vf = liftM M.fromList . mapM (\(k, v) -> liftM2 (,) (kf k) (vf v)) . M.assocs {-# INLINE mapMmap #-}
+ tests/Main.hs view
@@ -0,0 +1,209 @@+{-# LANGUAGE OverloadedStrings, ExistentialQuantification #-}++module Main where++import Test.HUnit+import Control.Monad (when)+import System.Exit (exitFailure)++import qualified Data.ByteString.Lazy.Char8 as BSL+import qualified Data.ByteString.Char8 as BS+import qualified Data.Text.Lazy as TL+import qualified Data.Text as T++import qualified Data.Vector as V+import qualified Data.Set as S+import qualified Data.Map as M++import Data.EDN (ToEDN, toEDN, fromEDN, Result(..))+import Data.EDN.Types as E+import Data.EDN.Parser (decode)+import Data.EDN.Encode (encode)++main :: IO ()+main = do+ (Counts _ _ e f) <- runTestTT tests+ when (e > 0 || f > 0) $ exitFailure++tests :: Test+tests = TestList [ TestLabel "BSL -> TV decoder" $ TestList $ map makeDecodeCase decodeCases+ , TestLabel "TV -> BSL encoder" $ TestList $ map makeEncodeCase encodeCases+ , TestLabel "decoder fail" (TestCase (assertEqual "bad unicode" Nothing (decode "№")))+ , TestLabel "ToEDN conversion" $ TestList $ map makeToEDNcase toEDNcases+ , TestLabel "'Tagged a' conversion" $ TestList taggedConversion+ ]++makeDecodeCase :: (BSL.ByteString, E.TaggedValue) -> Test+makeDecodeCase (i, o) = TestCase (assertEqual (BSL.unpack i) (Just o) (decode i))++makeEncodeCase :: (E.TaggedValue, BSL.ByteString) -> Test+makeEncodeCase (i, o) = TestCase (assertEqual (BSL.unpack o) o (encode i))++decodeCases :: [(BSL.ByteString, E.TaggedValue)]+decodeCases = [ ("nil", E.nil)++ , ("true", E.true)+ , ("false", E.false)++ , ("\"a nice string\"", "a nice string")+ , ("\"split\\second \\t\\rai\\n\"", "split\\second \t\rai\n")+ , ("\"test \\\"sausage\\\" shmest\"", "test \"sausage\" shmest")+ , ("\"\"", "")++ , ("\\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.symbolNS "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.notag $ E.makeList [])++ , ("[a b 42]", sampleVec)+ , ("[]", E.notag $ E.makeVec [])++ , ("{:a 1, \"foo\" :bar, [1 2 3] four}", sampleMap)+ , ("{}", E.notag $ E.makeMap [])++ , ("#{a b [1 2 3]}", sampleSet)+ , ("#{}", E.notag $ E.makeSet [])++ , ("[a b #_foo 42]", sampleDiscard)+ , ("(1 2 ;more to go!\n 3 4)", sampleComment)++ , ("#myapp/Person {:first \"Fred\" :last \"Mertz\"}", E.tag "myapp" "Person" sampleTaggedMap)+ , ("{:first \"Fred\" :last \"Mertz\"}", E.notag sampleTaggedMap)+ ]++encodeCases :: [(E.TaggedValue, BSL.ByteString)]+encodeCases = [ (E.nil, "nil")++ , (E.true, "true")+ , (E.false, "false")++ , (E.string "a nice string", "\"a nice string\"")+ , ("overloaded", "\"overloaded\"")+ , ("escape \rou\te \\ \"\north\"", "\"escape \\rou\\te \\\\ \\\"\\north\\\"\"")++ , (E.char 'c', "\\c")+ , (E.char '\\', "\\\\")+ , (E.char '\n', "\\newline")+ , (E.char '\t', "\\tab")+ , (E.char ' ', "\\space")++ , (E.symbol "justasymbol", "justasymbol")+ , (E.symbol "with#stuff:inside", "with#stuff:inside")+ , (E.symbolNS "whatever" "whenever", "whatever/whenever")+ , (E.symbol "/", "/")++ , (E.keyword "fred", ":fred")+ , (E.keyword "my/fred", ":my/fred")+ , (E.notag ":overloaded", ":overloaded") -- IsString kw transform only for untagged values++ , (E.integer 42, "42")+ , (E.integer (-1), "-1")++ , (E.floating 100.50, "100.5")+ , (E.floating (-3.14), "-3.14")++ , (sampleList, "(a b 42)")+ , (E.notag $ E.makeList [], "()")++ , (sampleVec, "[a b 42]")+ , (E.notag $ E.makeVec [], "[]")++ , (sampleMap, "{\"foo\" :bar :a 1 [1 2 3] four}") -- Order not guaranteed+ , (E.notag $ E.makeMap [], "{}")++ , (E.tag "myapp" "Person" sampleTaggedMap, "#myapp/Person {:first \"Fred\" :last \"Mertz\"}")+ ]++sampleList :: E.TaggedValue+sampleList = E.notag $ E.makeList [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.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.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.TaggedValue+sampleDiscard = E.notag $ E.makeVec [E.symbol "a", E.symbol "b", E.integer 42]++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 [ "first" .= "Fred", "last" .= "Mertz" ]++data ToEDNCase = forall a. ToEDN a => ToEDNCase !a !E.TaggedValue++makeToEDNcase :: ToEDNCase -> Test+makeToEDNcase (ToEDNCase i o) = TestCase (assertEqual (show o) o (toEDN i))++toEDNcases :: [ToEDNCase]+toEDNcases = [ ToEDNCase (Nothing :: Maybe Bool) E.nil++ , ToEDNCase (Left "hi" :: Either String ()) $ E.tag "either" "left" "hi"+ , ToEDNCase (Right "z" :: Either () String) $ E.tag "either" "right" "z"++ , ToEDNCase True E.true+ , ToEDNCase False E.false++ , ToEDNCase ("test" :: String) (E.string "test")+ , ToEDNCase ("test" :: BSL.ByteString) "test"+ , ToEDNCase ("test" :: BS.ByteString) "test"+ , ToEDNCase ("test" :: TL.Text) "test"+ , ToEDNCase ("test" :: T.Text) "test"++ , ToEDNCase 'c' $ E.char 'c'+ , ToEDNCase '\n' $ E.char '\n'+ , ToEDNCase '\\' $ E.char '\\'++ , ToEDNCase (3.14 :: Double) $ E.floating 3.14+ , ToEDNCase (42 :: Integer) $ E.integer 42++ , ToEDNCase () (E.notag $ E.makeList [])+ , ToEDNCase ([] :: [()]) (E.notag $ E.makeList [])+ , ToEDNCase (["yo", "wassup"] :: [String]) (E.notag $ E.makeList ["yo", "wassup"])+ , ToEDNCase [E.string "i", "am", E.symbolNS "boxed" "container"] (E.notag $ E.makeList [E.string "i", "am", E.symbolNS "boxed" "container"])++ , ToEDNCase (V.fromList ['o', 'm', 'g']) (E.notag $ E.makeVec [E.char 'o', E.char 'm', E.char 'g'])++ , ToEDNCase (S.fromList ['o', 'm', 'g']) (E.notag $ E.makeSet [E.char 'o', E.char 'm', E.char 'g'])++ , ToEDNCase (M.fromList [("test", "shmest"), ("foo", "bar")] :: M.Map String String) (E.notag $ E.makeMap [("test", "shmest"), ("foo", "bar")])+ , ToEDNCase (M.fromList [(":test", "shmest"), (":foo", "bar")] :: EDNMap) (E.notag $ E.makeMap ["test" .= "shmest", "foo" .= "bar"])+ ]+++taggedConversion :: [Test]+taggedConversion = [ TestCase (assertEqual "toEDN tagged" (E.tag "wo" "ot" (E.Boolean False)) (toEDN $ E.tag "wo" "ot" False))+ , TestCase (assertEqual "toEDN notag" E.false (toEDN $ E.notag False))+ , TestCase (assertEqual "fromEDN tagged" (Success $ E.tag "wo" "ot" False) (fromEDN $ E.tag "wo" "ot" (E.Boolean False)))+ , TestCase (assertEqual "fromEDN notag" (Success $ E.notag False) (fromEDN $ E.false))+ ]
− tests/TestEncoder.hs
@@ -1,9 +0,0 @@-{-# 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
@@ -1,118 +0,0 @@-{-# 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 = [ ("nil", E.nil)-- , ("true", E.true)- , ("false", E.false)-- , ("\"a nice string\"", "a nice string")- , ("\"split\\second \\t\\rai\\n\"", "split\\second \t\rai\n")- , ("\"test \\\"sausage\\\" shmest\"", "test \"sausage\" shmest")- , ("\"\"", "")-- , ("\\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.symbolNS "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.notag $ E.makeList [])-- , ("[a b 42]", sampleVec)- , ("[]", E.notag $ E.makeVec [])-- , ("{:a 1, \"foo\" :bar, [1 2 3] four}", sampleMap)- , ("{}", E.notag $ E.makeMap [])-- , ("#{a b [1 2 3]}", sampleSet)- , ("#{}", E.notag $ E.makeSet [])-- , ("[a b #_foo 42]", sampleDiscard)- , ("(1 2 ;more to go!\n 3 4)", sampleComment)-- , ("#myapp/Person {:first \"Fred\" :last \"Mertz\"}", E.tag "myapp" "Person" sampleTaggedMap)- , ("{:first \"Fred\" :last \"Mertz\"}", E.notag sampleTaggedMap)- ]--sampleList :: E.TaggedValue-sampleList = E.notag $ E.makeList [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.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.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.TaggedValue-sampleDiscard = E.notag $ E.makeVec [E.symbol "a", E.symbol "b", E.integer 42]--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 [ "first" ..= "Fred", "last" ..= "Mertz" ]