diff --git a/hedn.cabal b/hedn.cabal --- a/hedn.cabal +++ b/hedn.cabal @@ -2,7 +2,7 @@ -- see http://haskell.org/cabal/users-guide/ name: hedn -version: 0.1.5.2 +version: 0.1.6.0 synopsis: EDN parsing and encoding homepage: https://bitbucket.org/dpwiz/hedn license: BSD3 @@ -26,8 +26,8 @@ default: False library - exposed-modules: Data.EDN, Data.EDN.Types, Data.EDN.Parser, Data.EDN.Encode - other-modules: Data.Parser, Data.EDN.Types.Class + exposed-modules: Data.EDN, Data.EDN.Types, Data.EDN.Parser, Data.EDN.Encode, Data.EDN.Types.Class + other-modules: Data.Parser hs-source-dirs: src/ build-depends: base ==4.*, attoparsec, text, bytestring, containers, vector, stringsearch, mtl, deepseq diff --git a/src/Data/EDN.hs b/src/Data/EDN.hs --- a/src/Data/EDN.hs +++ b/src/Data/EDN.hs @@ -1,12 +1,12 @@ module Data.EDN ( + -- * Encoding and decoding + decode, encode, + -- * Core EDN types Value(..), TaggedValue, Tagged(..), - -- ** Type conversion - ToEDN, FromEDN, toEDN, fromEDN, fromEDNv, (.:), (.:?), - - -- * Tag manipulation - setTag, getTag, stripTag, + -- * Type conversion + ToEDN, FromEDN, toEDN, fromEDN, fromEDNv, (.:), (.:?), (.!=), -- * Constructors tag, notag, @@ -19,17 +19,16 @@ integer, floating, -- ** Containers - makeList, makeVec, makeSet, makeMap, (.=), + makeList, makeVec, makeSet, makeMap, Pair, (.=), - -- * Encoding - encode, fromValue, fromTagged, + -- * Tag manipulation + setTag, getTag, stripTag, -- * Parsing - decode, parseValue, parseTagged, Result(..) + parseMaybe ) where import Data.EDN.Types -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(..)) +import Data.EDN.Types.Class (decode, FromEDN, ToEDN, toEDN, fromEDN, fromEDNv, (.:), (.:?), (.!=), (.=)) +import Data.EDN.Encode (encode) +import Data.EDN.Parser (parseMaybe) diff --git a/src/Data/EDN/Encode.hs b/src/Data/EDN/Encode.hs --- a/src/Data/EDN/Encode.hs +++ b/src/Data/EDN/Encode.hs @@ -16,6 +16,7 @@ import qualified Data.Set as S import qualified Data.EDN.Types as E +import Data.EDN.Types.Class (ToEDN, toEDN) -- | Encode a Tagged EDN value to a 'Builder'. fromTagged :: E.TaggedValue -> Builder @@ -86,9 +87,9 @@ 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 +-- | Serialize a value as a lazy 'L.ByteString'. +encode :: ToEDN a => a -> L.ByteString +encode = encodeUtf8 . toLazyText . fromTagged . toEDN {-# INLINE encode #-} (<>) :: Builder -> Builder -> Builder diff --git a/src/Data/EDN/Parser.hs b/src/Data/EDN/Parser.hs --- a/src/Data/EDN/Parser.hs +++ b/src/Data/EDN/Parser.hs @@ -1,8 +1,11 @@ {-# LANGUAGE OverloadedStrings #-} +-- | Parse an UTF-8 encoded EDN string into a haskell representation of EDN objects. +-- Use 'Data.EDN.decode' to get actual types. + module Data.EDN.Parser ( -- * Data parsers - decode, parseBSL, parseBS, parseT, parseTL, parseS, + parseMaybe, parseBSL, parseBS, parseT, parseTL, parseS, -- * Attoparsec implementation parseValue, parseTagged ) where @@ -86,7 +89,7 @@ return $! Symbol ns val where withNS c = do - ns <- takeWhile1 (inClass "a-zA-Z0-9#:.*!?$%&=+_-") + ns <- takeWhile (inClass "a-zA-Z0-9#:.*!?$%&=+_-") char '/' vc <- satisfy (inClass "a-zA-Z.*/!?$%&=+_-") val <- takeWhile1 (inClass "a-zA-Z0-9#:.*!?$%&=+_-") @@ -199,9 +202,9 @@ 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 +-- | Parse a lazy 'BSL.ByteString' into a 'TaggedValue'. If fails due to incomplete or invalid input, 'Nothing' is returned. +parseMaybe :: BSL.ByteString -> Maybe TaggedValue +parseMaybe src = case parseBSL src of AL.Done _ r -> Just r _ -> Nothing @@ -229,4 +232,3 @@ parseS :: [Char] -> AL.Result TaggedValue parseS = parseBSL . BSL.pack {-# INLINE parseS #-} - diff --git a/src/Data/EDN/Types.hs b/src/Data/EDN/Types.hs --- a/src/Data/EDN/Types.hs +++ b/src/Data/EDN/Types.hs @@ -21,7 +21,7 @@ integer, floating, -- ** Containers - makeList, makeVec, makeSet, makeMap, (.=) + makeList, makeVec, makeSet, makeMap ) where import Data.String (IsString(..)) @@ -44,10 +44,10 @@ type TaggedValue = Tagged Value -type EDNList = [TaggedValue] -type EDNVec = V.Vector TaggedValue -type EDNMap = M.Map Value TaggedValue -type EDNSet = S.Set TaggedValue +type EDNList = [TaggedValue] -- ^ An EDN list (head:tail container). +type EDNVec = V.Vector TaggedValue -- ^ An EDN vector (position-indexed container) of EDN values. +type EDNMap = M.Map Value TaggedValue -- ^ An EDN map (key/value container). Keys are untagged and values are tagged. +type EDNSet = S.Set TaggedValue -- ^ An EDN set (unordered container of unique values). -- | A \"raw\" EDN value represented as a Haskell value. data Value = Nil @@ -157,7 +157,6 @@ stripTag (Tagged v _ _) = v {-# INLINE stripTag #-} - -- | Create an EDN 'List' from a 'Value' list wrapping them into empty tags. makeList :: [TaggedValue] -> Value makeList = List @@ -180,8 +179,3 @@ 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 (.=) #-} diff --git a/src/Data/EDN/Types/Class.hs b/src/Data/EDN/Types/Class.hs --- a/src/Data/EDN/Types/Class.hs +++ b/src/Data/EDN/Types/Class.hs @@ -1,11 +1,19 @@ {-# LANGUAGE OverloadedStrings, FlexibleInstances, IncoherentInstances #-} module Data.EDN.Types.Class ( - ToEDN, FromEDN, toEDN, fromEDN, fromEDNv, (.:), (.:?) + -- * Type conversion + ToEDN(..), FromEDN(..), fromEDN, fromEDNv, + + -- * EDN value decoding + decode, DP.parse, DP.parseEither, DP.parseMaybe, DP.Parser, DP.Result(..), + + -- * Convenience functions + (.=), (.:), (.:?), (.!=), typeMismatch ) where import Control.Applicative (pure, (<$>)) import Control.Monad (liftM, liftM2) +import Data.Maybe (fromMaybe) import qualified Data.Text as T import qualified Data.Text.Lazy as TL import qualified Data.Text.Encoding as TE @@ -16,9 +24,12 @@ import qualified Data.Set as S import qualified Data.Map as M -import qualified Data.Parser as P +import Data.Parser (Parser, Result) +import qualified Data.Parser as DP +import qualified Data.EDN.Parser as P import qualified Data.EDN.Types as E +-- | A type that can be converted to JSON. class ToEDN a where toEDN :: a -> E.TaggedValue toEDN = E.notag . toEDNv @@ -28,12 +39,17 @@ toEDNv = E.stripTag . toEDN {-# INLINE toEDNv #-} +-- | A type that can be converted from EDN, with a possibility of failure. +-- +-- When writing an instance, use 'empty', 'mzero', or 'fail' to make a +-- conversion fail, e.g. if an 'M.Map' is missing a required key, or +-- the value is of the wrong type. class FromEDN a where - parseEDN :: E.TaggedValue -> P.Parser a + parseEDN :: E.TaggedValue -> Parser a parseEDN = parseEDNv . E.stripTag {-# INLINE parseEDN #-} - parseEDNv :: E.Value -> P.Parser a + parseEDNv :: E.Value -> Parser a parseEDNv = parseEDN . E.notag {-# INLINE parseEDNv #-} @@ -211,15 +227,27 @@ parseEDN = pure -- | Convert a value from 'E.TaggedValue', failing if the types do not match. -fromEDN :: FromEDN a => E.TaggedValue -> P.Result a -fromEDN = P.parse parseEDN +fromEDN :: FromEDN a => E.TaggedValue -> Result a +fromEDN = DP.parse parseEDN {-# INLINE fromEDN #-} -- | Convert a value from 'E.Value', failing if the types do not match. -fromEDNv :: FromEDN a => E.Value -> P.Result a -fromEDNv = P.parse parseEDNv +fromEDNv :: FromEDN a => E.Value -> Result a +fromEDNv = DP.parse parseEDNv {-# INLINE fromEDNv #-} +-- | Deserializes a EDN value from a lazy 'BSL.ByteString'. +-- If this fails to to incomplete or invalid input, 'Nothing' is returned. +decode :: FromEDN a => BSL.ByteString -> Maybe a +decode s = case P.parseMaybe s of + Just tv -> DP.parseMaybe parseEDN tv + Nothing -> Nothing + +-- | Construct a 'Pair' from a key (as EDN keyword) and a value. +(.=) :: ToEDN a => BS.ByteString -> a -> E.Pair +name .= value = (E.Keyword name, toEDN value) +{-# INLINE (.=) #-} + -- | 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. @@ -227,7 +255,7 @@ -- 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 +(.:) :: (Show k, ToEDN k, FromEDN a) => E.EDNMap -> k -> Parser a emap .: key = case M.lookup (toEDNv key) emap of Nothing -> fail $ "key " ++ show key ++ " not present" Just v -> parseEDN v @@ -240,16 +268,34 @@ -- 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) +(.:?) :: (ToEDN k, FromEDN a) => E.EDNMap -> k -> Parser (Maybe a) emap .:? key = case M.lookup (toEDNv key) emap of Nothing -> pure Nothing Just v -> parseEDN v {-# INLINE (.:?) #-} +-- | Helper for use in combination with '.:?' to provide default +-- values for optional JSON object fields. +-- +-- This combinator is most useful if the key and value can be absent +-- from an object without affecting its validity and we know a default +-- value to assign in that case. If the key and value are mandatory, +-- use '(.:)' instead. +-- +-- Example usage: +-- +-- @ v1 <- o '.:?' \"opt_field_with_dfl\" .!= \"default_val\" +-- v2 <- o '.:' \"mandatory_field\" +-- v3 <- o '.:?' \"opt_field2\" +-- @ +(.!=) :: Parser (Maybe a) -> a -> Parser a +pmval .!= val = fromMaybe val <$> pmval +{-# 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. - -> P.Parser a + -> Parser a typeMismatch expected actual = fail $ "when expecting a " ++ expected ++ ", encountered " ++ name ++ " instead" diff --git a/tests/Main.hs b/tests/Main.hs --- a/tests/Main.hs +++ b/tests/Main.hs @@ -15,10 +15,10 @@ import qualified Data.Set as S import qualified Data.Map as M -import Data.EDN (ToEDN, toEDN, fromEDN, Result(..)) +import Data.EDN (encode, decode, ToEDN, toEDN, FromEDN, fromEDN) import Data.EDN.Types as E -import Data.EDN.Parser (decode) -import Data.EDN.Encode (encode) +import Data.EDN.Types.Class (Result(..), (.=)) +import Data.EDN.Parser (parseMaybe) main :: IO () main = do @@ -26,21 +26,22 @@ when (e > 0 || f > 0) $ exitFailure tests :: Test -tests = TestList [ TestLabel "BSL -> TV decoder" $ TestList $ map makeDecodeCase decodeCases +tests = TestList [ TestLabel "BSL -> TV parser" $ TestList $ map makeParserCase parserCases , 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 "FromEDN converter/decoder" $ TestList $ map makeFromEDNcase fromEDNcases + , TestLabel "decoder fail" (TestCase (assertEqual "bad unicode" Nothing (parseMaybe "№"))) , TestLabel "'Tagged a' conversion" $ TestList taggedConversion ] -makeDecodeCase :: (BSL.ByteString, E.TaggedValue) -> Test -makeDecodeCase (i, o) = TestCase (assertEqual (BSL.unpack i) (Just o) (decode i)) +makeParserCase :: (BSL.ByteString, E.TaggedValue) -> Test +makeParserCase (i, o) = TestCase (assertEqual (BSL.unpack i) (Just o) (parseMaybe 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) +parserCases :: [(BSL.ByteString, E.TaggedValue)] +parserCases = [ ("nil", E.nil) , ("true", E.true) , ("false", E.false) @@ -159,7 +160,7 @@ 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" ] +sampleTaggedMap = E.makeMap [ "first" .= E.string "Fred", "last" .= E.string "Mertz" ] data ToEDNCase = forall a. ToEDN a => ToEDNCase !a !E.TaggedValue @@ -171,6 +172,7 @@ , ToEDNCase (Left "hi" :: Either String ()) $ E.tag "either" "left" "hi" , ToEDNCase (Right "z" :: Either () String) $ E.tag "either" "right" "z" + , ToEDNCase (Just '!') (E.char '!') , ToEDNCase True E.true , ToEDNCase False E.false @@ -198,9 +200,36 @@ , 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"]) + , ToEDNCase (M.fromList [(":test", "shmest"), (":foo", "bar")] :: EDNMap) (E.notag $ E.makeMap ["test" .= E.string "shmest", "foo" .= E.string "bar"]) ] +data FromEDNCase = forall a. (FromEDN a, Show a, Eq a) => FromEDNCase !BSL.ByteString !a + +makeFromEDNcase :: FromEDNCase -> Test +makeFromEDNcase (FromEDNCase i o) = TestCase $ assertEqual (BSL.unpack i) (Just o) (decode i) + +fromEDNcases :: [FromEDNCase] +fromEDNcases = [ FromEDNCase "nil" (Nothing :: Maybe Bool) + + , FromEDNCase "false" False + , FromEDNCase "true" True + + , FromEDNCase "#either/left hi" (Left "hi" :: Either String ()) + , FromEDNCase "#either/right z" (Right "z" :: Either () String) + , FromEDNCase "\"ok fine\"" (Just "ok fine" :: Maybe T.Text) + , FromEDNCase "nil" (Nothing :: Maybe BSL.ByteString) + + , FromEDNCase "\\newline" '\n' + , FromEDNCase "\\z" 'z' + + , FromEDNCase "42" (42 :: Integer) + , FromEDNCase "-3.14" (-3.14 :: Double) + + , FromEDNCase "(hello world)" (["hello", "world"] :: [String]) + , FromEDNCase "[3 2 1 \"Kaboom!\"]" $ E.makeVec [E.integer 3, E.integer 2, E.integer 1, "Kaboom!"] + , FromEDNCase "#{a/bag :of \"bugs\"}" $ E.makeSet [E.symbolNS "a" "bag", E.keyword "of", E.string "bugs"] + , FromEDNCase "{json: \"like\", but/not: \"really\"}" $ (M.fromList [("json:", "like"), ("but/not:", "really")] :: M.Map String String) + ] taggedConversion :: [Test] taggedConversion = [ TestCase (assertEqual "toEDN tagged" (E.tag "wo" "ot" (E.Boolean False)) (toEDN $ E.tag "wo" "ot" False))