hedn 0.1.7.0 → 0.1.8.1
raw patch · 5 files changed
+74/−25 lines, 5 filesdep +utf8-string
Dependencies added: utf8-string
Files
- hedn.cabal +8/−4
- src/Data/EDN/Parser.hs +42/−11
- src/Data/EDN/Types/Class.hs +10/−1
- tests/Data/EDN/Test/QuickCheck.hs +9/−9
- tests/Data/EDN/Test/Unit.hs +5/−0
hedn.cabal view
@@ -1,5 +1,5 @@ name: hedn-version: 0.1.7.0+version: 0.1.8.1 synopsis: EDN parsing and encoding homepage: https://bitbucket.org/dpwiz/hedn license: BSD3@@ -23,6 +23,7 @@ flag developer description: operate in developer mode default: False+ manual: True library exposed-modules:@@ -41,6 +42,7 @@ attoparsec, text, bytestring >=0.10,+ utf8-string, containers, vector, stringsearch,@@ -49,9 +51,9 @@ old-locale, time --- if flag(developer)--- ghc-options: -Werror -fhpc--- ghc-prof-options: -auto-all+ if flag(developer)+ ghc-options: -Werror+ ghc-prof-options: -auto-all -fhpc ghc-options: -O2 -Wall -fno-warn-unused-do-bind @@ -62,6 +64,8 @@ build-depends: base, hedn, bytestring, text, containers, vector, template-haskell, time, QuickCheck >= 2.5.1, hspec == 1.5.*, HUnit >= 1.2.5 ghc-options: -Wall+ if flag(developer)+ ghc-options: -Werror -fhpc source-repository head type: mercurial
src/Data/EDN/Parser.hs view
@@ -5,7 +5,7 @@ module Data.EDN.Parser ( -- * Data parsers- parseMaybe, parseBSL, parseBS, parseT, parseTL, parseS,+ parseMaybe, parseEither, parseBSL, parseBS, parseT, parseTL, parseS, -- * Attoparsec implementation parseValue, parseTagged ) where@@ -14,6 +14,7 @@ import Data.Attoparsec.Char8 as A import Data.Attoparsec.Combinator () import qualified Data.Attoparsec.Lazy as AL+import qualified Data.ByteString.UTF8 as UTF8 import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Lazy.Char8 as BSL import Data.ByteString.Search (replace)@@ -26,6 +27,7 @@ import Data.EDN.Types (Tagged (..), TaggedValue, Value (..), makeMap, makeSet, makeVec)+import qualified Prelude as P isSpaceOrComma :: Char -> Bool isSpaceOrComma ' ' = True@@ -82,14 +84,41 @@ parseCharacter = do skipSoC char '\\'- x <- string "newline" <|> string "space" <|> string "tab" <|> A.take 1- return . Character $! case x of- "newline" -> '\n'- "return" -> '\r'- "space" -> ' '- "tab" -> '\t'- _ -> BS.head x+ simple <|> anyCharUtf8 + where+ simple :: Parser Value+ simple = do+ x <- string "newline"+ <|> string "return"+ <|> string "space"+ <|> string "tab"+ <|> string "\\"++ return . Character $! case x of+ "newline" -> '\n'+ "return" -> '\r'+ "space" -> ' '+ "tab" -> '\t'+ "\\" -> '\\'+ _ -> error ("EDN.parseCharacter: impossible - simple" ++ show x)++ anyCharUtf8 :: Parser Value+ anyCharUtf8 = do+ bs <- scan BS.empty go+ case UTF8.decode bs of+ Just (c, _) -> return $! Character c+ Nothing -> error $ "EDN.parseCharacter: bad utf8 data? " ++ show bs++ go :: BS.ByteString -> Char -> Maybe BS.ByteString+ go s c+ | BS.null s = Just (BS.singleton c)+ | otherwise = case UTF8.decode s of+ Nothing -> Just (s `BS.snoc` c)+ Just (uc, _) -> if uc == UTF8.replacement_char+ then Just (s `BS.snoc` c)+ else Nothing+ parseSymbol :: Parser Value parseSymbol = do skipSoC@@ -221,9 +250,11 @@ -- | 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+parseMaybe = AL.maybeResult . parseBSL++-- | Parse a lazy 'BSL.ByteString' into a 'TaggedValue'. If fails due to incomplete or invalid input, 'Left' is returned with the error message.+parseEither :: BSL.ByteString -> Either P.String TaggedValue+parseEither = AL.eitherResult . parseBSL -- | Parse a lazy 'BSL.ByteString'. parseBSL :: BSL.ByteString -> AL.Result TaggedValue
src/Data/EDN/Types/Class.hs view
@@ -6,7 +6,7 @@ ToEDN(..), FromEDN(..), fromEDN, fromEDNv, -- * EDN value decoding- decode, DP.parse, DP.parseEither, DP.parseMaybe, DP.Parser, DP.Result(..),+ decode, eitherDecode, DP.parse, DP.parseEither, DP.parseMaybe, DP.Parser, DP.Result(..), -- * Convenience functions (.=), (.:), (.:?), (.!=), typeMismatch@@ -228,6 +228,7 @@ {-# INLINE toEDNv #-} instance FromEDN a => FromEDN [a] where+ parseEDNv (E.Vec vs) = V.mapM parseEDN vs >>= return . V.toList parseEDNv (E.List vs) = mapM parseEDN vs parseEDNv v = typeMismatch "List" v {-# INLINE parseEDNv #-}@@ -427,6 +428,14 @@ decode s = case P.parseMaybe s of Just tv -> DP.parseMaybe parseEDN tv Nothing -> Nothing++-- | Deserializes a EDN value from a lazy 'BSL.ByteString'.+-- If this fails to to incomplete or invalid input, 'Left' is returned+-- with an error message.+eitherDecode :: FromEDN a => BSL.ByteString -> Either String a+eitherDecode s = case P.parseEither s of+ Right tv -> DP.parseEither parseEDN tv+ Left e -> Left e -- | Construct a 'Pair' from a key (as EDN keyword) and a value. (.=) :: ToEDN a => BS.ByteString -> a -> E.Pair
tests/Data/EDN/Test/QuickCheck.hs view
@@ -61,14 +61,14 @@ type Tuple4 = (Int, String, [Maybe UTCTime], [Maybe Bool]) type Tuple5 = (Int, [String], [Maybe UTCTime], [Maybe Bool], (Bool, Bool)) -$(mkSerializeSpecs [- -- ''Char -- encode/decode are not isomorphic with Char- -- ''Double -- encode/decode are not isomorphic with Double- -- ''String- ''UTCTime+$(mkSerializeSpecs [ ''Char+ , ''Double+ , ''String+ , ''UTCTime , ''MUTCTime- -- , ''Tuple- -- , ''Triple- -- , ''Tuple4- -- , ''Tuple5+ , ''Tuple+ , ''Triple+ , ''Tuple4+ , ''Tuple5 ])+
tests/Data/EDN/Test/Unit.hs view
@@ -218,7 +218,12 @@ , FromEDNCase "42" (42 :: Integer) , FromEDNCase "-3.14" (-3.14 :: Double) + , FromEDNCase "([1 2] [3 4])" ([(1,2), (3,4)]:: [(Int,Int)])+ , FromEDNCase "((1 2) (3 4))" ([[1,2], [3,4]]:: [[Int]])+ , FromEDNCase "[[1 2] [3 4]]" ([(1,2), (3,4)]:: [(Int, Int)])+ , FromEDNCase "[[1 2] [3 4]]" ([[1,2], [3,4]]:: [[Int]]) , 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)