diff --git a/hedn.cabal b/hedn.cabal --- a/hedn.cabal +++ b/hedn.cabal @@ -1,5 +1,5 @@ name: hedn -version: 0.1.9.0 +version: 0.1.9.1 synopsis: EDN parsing and encoding homepage: https://bitbucket.org/dpwiz/hedn license: BSD3 @@ -15,7 +15,9 @@ GHC==7.6.3, GHC==7.8.4, GHC==7.10.3, - GHC==8.0.1 + GHC==8.0.1, + GHC==8.2.2, + GHC==8.4.4 description: A EDN parsing and encoding library inspired by Data.Aeson. 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 @@ -2,7 +2,7 @@ module Data.EDN.Encode (fromValue, fromTagged, encode) where -import Data.Monoid (mappend) +import Data.Monoid ((<>)) import qualified Data.Text as T import Data.Text.Lazy.Builder import Data.Text.Lazy.Builder.Int (decimal) @@ -79,20 +79,15 @@ fromList :: [E.TaggedValue] -> Builder fromList [] = "" -fromList (x:[]) = fromTagged x +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)] = fromValue k <> singleton ' ' <> fromTagged v fromAssoc ((k, v):as) = fromValue k <> singleton ' ' <> fromTagged v <> singleton ' ' <> fromAssoc as -- | Serialize a value as a lazy 'L.ByteString'. encode :: ToEDN a => a -> L.ByteString encode = encodeUtf8 . toLazyText . fromTagged . toEDN {-# INLINE encode #-} - -(<>) :: Builder -> Builder -> Builder -(<>) = mappend -{-# INLINE (<>) #-} -infixr 6 <> 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 @@ -14,6 +14,7 @@ import Prelude.Compat hiding (String, takeWhile) import Control.Applicative ((<|>)) +import Control.Monad (void) import Data.Attoparsec.ByteString.Char8 as A import Data.Attoparsec.Combinator () import qualified Data.Attoparsec.Lazy as AL @@ -21,6 +22,7 @@ import qualified Data.ByteString.Lazy.Char8 as BSL import Data.ByteString.Search (replace) import qualified Data.ByteString.UTF8 as UTF8 +import Data.Functor (($>)) import Data.Maybe (fromJust) import Data.Scientific as Sci import qualified Data.Text as T @@ -50,8 +52,7 @@ parseNil :: Parser Value parseNil = do skipSoC - string "nil" - return Nil + string "nil" $> Nil parseBool :: Parser Value parseBool = do @@ -63,14 +64,14 @@ parseString :: Parser Value parseString = do skipSoC - char '"' + void $ char '"' x <- A.scan False $ \s c -> if s then Just False else if c == '"' then Nothing else Just (c == '\\') - char '"' + void $ char '"' let prepare = if '\\' `BS.elem` x then rep "\\\"" "\"" @@ -89,8 +90,7 @@ parseCharacter :: Parser Value parseCharacter = do skipSoC - char '\\' - simple <|> anyCharUtf8 + char '\\' *> (simple <|> anyCharUtf8) where simple :: Parser Value @@ -134,8 +134,7 @@ where withNS c = do ns <- takeWhile (inClass "a-zA-Z0-9#:.*<>!?$%&=+_-") - char '/' - vc <- satisfy (inClass "a-zA-Z.*/<>!?$%&=+_-") + vc <- char '/' *> satisfy (inClass "a-zA-Z.*/<>!?$%&=+_-") val <- takeWhile1 (inClass "a-zA-Z0-9#:.*<>!?$%&=+_-") return (c `BS.cons` ns, vc `BS.cons` val) @@ -146,9 +145,8 @@ parseKeyword :: Parser Value parseKeyword = do skipSoC - char ':' - c <- satisfy (inClass "a-zA-Z.*/<>!?$%&=+_-") - x <- takeWhile (inClass "a-zA-Z0-9#:.*/<>!?$%&=+_-") + c <- char ':' *> satisfy (inClass "a-zA-Z.*/<>!?$%&=+_-") + x <- takeWhile (inClass "a-zA-Z0-9#:.*/<>!?$%&=+_-") return $! Keyword (c `BS.cons` x) parseNumber :: Parser Value @@ -203,9 +201,8 @@ parseDiscard :: Parser () parseDiscard = do skipSoC - string "#_" - parseValue - return () + void $ string "#_" + void parseValue -- | Parse a \"raw\" EDN value into a 'Value'. parseValue :: Parser Value @@ -229,16 +226,13 @@ withNS <|> withoutNS <|> noTag where withNS = do - char '#' - ns <- parseIdent - char '/' - tag <- parseIdent + ns <- char '#' *> parseIdent + tag <- char '/' *> parseIdent value <- parseValue return $! Tagged value ns tag withoutNS = do - char '#' - tag <- parseIdent + tag <- char '#' *> parseIdent value <- parseValue return $! Tagged value "" tag 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 @@ -16,7 +16,7 @@ import Prelude () import Prelude.Compat -import Control.Monad (liftM, liftM2) +import Control.Monad (liftM2) import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Lazy.Char8 as BSL import qualified Data.Map as M @@ -43,6 +43,8 @@ -- | A type that can be converted to JSON. class ToEDN a where + {-# MINIMAL toEDN | toEDNv #-} + toEDN :: a -> E.TaggedValue toEDN = E.notag . toEDNv {-# INLINE toEDN #-} @@ -57,6 +59,8 @@ -- 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 + {-# MINIMAL parseEDN | parseEDNv #-} + parseEDN :: E.TaggedValue -> Parser a parseEDN = parseEDNv . E.stripTag {-# INLINE parseEDN #-} @@ -83,7 +87,7 @@ instance (FromEDN a, FromEDN b) => FromEDN (Either a b) where parseEDN (E.Tagged v "either" "left") = Left <$> parseEDNv v parseEDN (E.Tagged v "either" "right") = Right <$> parseEDNv v - parseEDN (E.Tagged {}) = fail "incorrect tag" + parseEDN E.Tagged{} = fail "incorrect tag" parseEDN (E.NoTag _) = fail "no tag" {-# INLINE parseEDN #-} @@ -531,5 +535,5 @@ -> (b1 -> m b2) -> M.Map a1 b1 -> m (M.Map a2 b2) -mapMmap kf vf = liftM M.fromList . mapM (\(k, v) -> liftM2 (,) (kf k) (vf v)) . M.assocs +mapMmap kf vf = fmap M.fromList . mapM (\(k, v) -> liftM2 (,) (kf k) (vf v)) . M.assocs {-# INLINE mapMmap #-} diff --git a/src/Data/Parser.hs b/src/Data/Parser.hs --- a/src/Data/Parser.hs +++ b/src/Data/Parser.hs @@ -13,6 +13,7 @@ import Control.Applicative import Control.DeepSeq (NFData(..)) import Control.Monad.State.Strict +import Data.Semigroup (Semigroup, (<>)) import Data.Typeable (Typeable) -- | The result of running a 'Parser'. @@ -55,10 +56,13 @@ (<|>) = mplus {-# INLINE (<|>) #-} +instance Semigroup (Result a) where + (<>) = mplus + instance Monoid (Result a) where mempty = fail "mempty" {-# INLINE mempty #-} - mappend = mplus + mappend = (<>) {-# INLINE mappend #-} -- | Failure continuation. @@ -107,17 +111,19 @@ in runParser a kf' ks {-# INLINE mplus #-} +instance Semigroup (Parser a) where + (<>) = mplus + instance Monoid (Parser a) where mempty = fail "mempty" {-# INLINE mempty #-} - mappend = mplus + mappend = (<>) {-# INLINE mappend #-} apP :: Parser (a -> b) -> Parser a -> Parser b apP d e = do b <- d - a <- e - return (b a) + b <$> e {-# INLINE apP #-} -- | Run a 'Parser'. diff --git a/tests/Data/EDN/Test/QuickCheck/TH.hs b/tests/Data/EDN/Test/QuickCheck/TH.hs --- a/tests/Data/EDN/Test/QuickCheck/TH.hs +++ b/tests/Data/EDN/Test/QuickCheck/TH.hs @@ -9,12 +9,11 @@ import qualified Data.EDN as E -import qualified Test.QuickCheck as QC -------------------------------------------------------------------------------- -serializeProperty :: (QC.Arbitrary a, Eq a, E.ToEDN a, E.FromEDN a) => a -> Bool -serializeProperty object = do +serializeProperty :: (Eq a, E.ToEDN a, E.FromEDN a) => a -> Bool +serializeProperty object = case decoded of Just result -> result == object Nothing -> False @@ -24,19 +23,19 @@ getTestPropertyName :: Name -> Name getTestPropertyName qualTypeName = - mkName $ "test" ++ (nameBase qualTypeName) ++ "Serialization" + mkName $ "test" ++ nameBase qualTypeName ++ "Serialization" mkEDNSerializeSpecGroup :: [Name] -> Q [Dec] mkEDNSerializeSpecGroup names = do let fnName = mkName "ednSerializationProperties" specType <- [t| Spec |] describeFn <- [| describe |] - return $ [ SigD fnName specType - , ValD (VarP fnName) - (NormalB (AppE (AppE describeFn - (LitE (StringL "EDN.Serialization"))) - (DoE (map (NoBindS . VarE . getTestPropertyName) - names)))) []] + return [ SigD fnName specType + , ValD (VarP fnName) + (NormalB (AppE (AppE describeFn + (LitE (StringL "EDN.Serialization"))) + (DoE (map (NoBindS . VarE . getTestPropertyName) + names)))) []] mkSerializeSpec :: Name -> Q [Dec] mkSerializeSpec qualTypeName = do @@ -58,4 +57,4 @@ mkSerializeSpecs :: [Name] -> Q [Dec] mkSerializeSpecs types = (++) <$> (concat `fmap` mapM mkSerializeSpec types) - <*> (mkEDNSerializeSpecGroup types) + <*> mkEDNSerializeSpecGroup types diff --git a/tests/Data/EDN/Test/Unit.hs b/tests/Data/EDN/Test/Unit.hs --- a/tests/Data/EDN/Test/Unit.hs +++ b/tests/Data/EDN/Test/Unit.hs @@ -226,13 +226,13 @@ , 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) - , FromEDNCase "{ json: \"like\", but/not: \"really\" }" $ (M.fromList [("json:", "like"), ("but/not:", "really")] :: M.Map String String) + , FromEDNCase "{json: \"like\", but/not: \"really\"}" (M.fromList [("json:", "like"), ("but/not:", "really")] :: M.Map String String) + , 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)) , 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)) + , TestCase (assertEqual "fromEDN notag" (Success $ E.notag False) (fromEDN E.false)) ]