diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -3,6 +3,22 @@ All notable changes to this project will be documented in this file. This project adheres to [Semantic Versioning](http://semver.org/). +## [0.3.0.0] - 2019-09-29 + +### Added + +- GHC 8.8 support + +### Removed + +- GHC 8.0 (Stackage LTS < 11) aren't supported due to upstream changes. + You can still find a package version combination that'll work for you. + +### Changed + +- AST Parser `parseText` and EDN `decodeText` no longer rely on MonadFail + and work in `Either String` instead. + ## [0.2.0.1] - 2019-02-18 ### Changed @@ -61,6 +77,7 @@ - Use utf8-string parsing for unicode literals. +[0.3.0.0]: https://gitlab.com/dpwiz/hedn/tree/v0.3.0.0 [0.2.0.1]: https://gitlab.com/dpwiz/hedn/tree/v0.2.0.1 [0.2.0.0]: https://gitlab.com/dpwiz/hedn/tree/0.2.0.0 [0.1.9.1]: https://gitlab.com/dpwiz/hedn/tree/0.1.9.1 diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -38,8 +38,7 @@ main = do edn <- Text.readFile "example.edn" - value <- EDN.parseText "example.edn" edn - print value + either error print $ EDN.parseText "example.edn" edn ``` ```haskell diff --git a/example.edn b/example.edn deleted file mode 100644 --- a/example.edn +++ /dev/null @@ -1,12 +0,0 @@ -(#haskell/edn example/kitchensink ; tagged symbol - nil ; ugh.. - \space ; character - "dynamic \"typing\"" ; string - {:numbers ; keyword - [42 ; integer - 42.0 ; floating - ] ; Vector - :bools - #{true false} ; Set - } ; Map -) ; List diff --git a/hedn.cabal b/hedn.cabal --- a/hedn.cabal +++ b/hedn.cabal @@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack -- --- hash: 3422cbfa0f065b597c1a18d7b765dcd6ddddbea6b62aceab67212f90c480a468 +-- hash: 51ffeea2c9239d08c2d1e746437afcd12120103d004da5308747b27a697dcd05 name: hedn -version: 0.2.0.1 +version: 0.3.0.0 synopsis: EDN parsing and encoding description: A EDN parsing and encoding library. . @@ -18,13 +18,12 @@ copyright: (c) 2019 Alexander Bondarenko license: BSD3 license-file: LICENSE -tested-with: GHC==8.0.1, GHC==8.2.2, GHC==8.4.4, GHC==8.6.3 +tested-with: GHC==8.2.2, GHC==8.4.4, GHC==8.6.3, GHC==8.8.1 build-type: Simple extra-source-files: CHANGELOG.md LICENSE README.md - example.edn source-repository head type: git @@ -48,7 +47,7 @@ lib ghc-options: -Wall build-depends: - base >=4.9 && <4.13 + base >=4.9 && <4.14 , containers >=0.5.7 && <0.7 , deepseq >=1.4 && <2 , deriving-compat >=0.3.6 && <0.6 @@ -77,9 +76,9 @@ tests ghc-options: -Wall build-depends: - base >=4.9 && <4.13 + base >=4.9 && <4.14 , containers >=0.5.7 && <0.7 - , hedgehog >=0.6 && <0.7 + , hedgehog >=0.6 && <2 , hedn >=0.2 && <1 , megaparsec >=7.0 && <8 , text >=1.2 && <2 diff --git a/lib/Data/EDN.hs b/lib/Data/EDN.hs --- a/lib/Data/EDN.hs +++ b/lib/Data/EDN.hs @@ -61,10 +61,10 @@ -- | Decode EDN document into AST and parse value using its 'FromEDN' instance. decodeText - :: (FromEDN a, Monad m) + :: (FromEDN a) => String -- ^ Source name, for megaparsec error reports -- e.g. @/path/to/file.edn@ or @@ -> Text -- ^ EDN document body - -> m a + -> Either String a decodeText sourceName source = parseText sourceName source >>= fromEDN diff --git a/lib/Data/EDN/AST/Parser.hs b/lib/Data/EDN/AST/Parser.hs --- a/lib/Data/EDN/AST/Parser.hs +++ b/lib/Data/EDN/AST/Parser.hs @@ -42,17 +42,13 @@ import qualified Data.EDN.AST.Types as EDN parseText - :: Monad m - => String -- ^ Source name, for megaparsec error reports + :: String -- ^ Source name, for megaparsec error reports -- e.g. @/path/to/file.edn@ or @@ -> Text -- ^ EDN document body - -> m TaggedValue -parseText sourceName source = - case P.parse parseDoc sourceName source of - Right tv -> - pure tv - Left err -> - fail (P.errorBundlePretty err) + -> Either String TaggedValue +parseText sourceName = + either (Left . P.errorBundlePretty) Right . + P.parse parseDoc sourceName parseDoc :: Parser TaggedValue parseDoc = do diff --git a/lib/Data/EDN/Class.hs b/lib/Data/EDN/Class.hs --- a/lib/Data/EDN/Class.hs +++ b/lib/Data/EDN/Class.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedLists #-} @@ -39,7 +40,10 @@ import Control.Applicative ((<|>)) import Data.Map (Map) +#if MIN_VERSION_base(4,12,0) +#else import Data.Semigroup ((<>)) +#endif import Data.Set (Set) import Data.Text (Text) import Data.Time (UTCTime, defaultTimeLocale, formatTime, parseTimeM) @@ -169,7 +173,7 @@ | tagNS' == tagNS && tag == tag' -> p v | otherwise -> - fail . Text.unpack $ mconcat + DP.parserError . Text.unpack $ mconcat [ "unexpected tag. " , "expecting: #" , nsToText tagNS' tag' @@ -177,7 +181,7 @@ , nsToText tagNS tag ] _ -> - fail "expected tagged value" + DP.parserError "expected tagged value" withNoTag :: (EDN.Value -> DP.Parser a) -> EDN.TaggedValue -> DP.Parser a withNoTag p tv = @@ -185,7 +189,7 @@ EDN.NoTag v -> p v EDN.Tagged tagNS tag _v -> - fail $ "no tag expected, got #" <> Text.unpack (nsToText tagNS tag) + DP.parserError $ "no tag expected, got #" <> Text.unpack (nsToText tagNS tag) withNil :: DP.Parser a -> EDN.Value -> DP.Parser a withNil p = \case @@ -329,8 +333,8 @@ {-# INLINE parseEDNv #-} -- | Apply appropriate parsers for a value to decode AST. -fromEDN :: (FromEDN a, Monad m) => EDN.TaggedValue -> m a -fromEDN = DP.parseM parseEDN +fromEDN :: (FromEDN a) => EDN.TaggedValue -> Either String a +fromEDN = DP.parseEither parseEDN instance FromEDN EDN.TaggedValue where parseEDN = pure @@ -339,7 +343,7 @@ parseEDNv = pure instance FromEDN Void where - parseEDN = fail "absurd" + parseEDN _ = DP.parserError "unable to construct Void value" instance FromEDN () where parseEDNv = withNil $ pure () @@ -387,7 +391,7 @@ vecGet ix v = case v Vector.!? ix of Nothing -> - fail $ unwords + DP.parserError $ unwords [ "expected vector with at least" , show (succ ix) , "elements" @@ -407,17 +411,16 @@ -- | Get a value from 'EDN.EDNMap' and apply a parser to it mapGetP - :: Monad m - => EDN.TaggedValue -- ^ Map key - -> (EDN.TaggedValue -> m a) -- ^ Parser to apply to a value - -> EDN.EDNMap -- ^ Map with EDN keys and values - -> m a + :: EDN.TaggedValue -- ^ Map key + -> (EDN.TaggedValue -> DP.Parser a) -- ^ Parser to apply to a value + -> EDN.EDNMap -- ^ Map with EDN keys and values + -> DP.Parser a mapGetP key inner m = case Map.lookup key m of Just tv -> inner tv Nothing -> - fail . Text.unpack $ "key not found: " <> renderText key + DP.parserError . Text.unpack $ "key not found: " <> renderText key -- | Get a value from 'EDN.EDNMap' for a 'EDN.Keyword' key. mapGetKeyword :: FromEDN a => Text -> EDN.EDNMap -> DP.Parser a @@ -445,21 +448,21 @@ [a, b] -> (,) <$> parseEDN a <*> parseEDN b _ -> - fail "vector of size 2 expected" + DP.parserError "vector of size 2 expected" instance (FromEDN a, FromEDN b, FromEDN c) => FromEDN (a, b, c) where parseEDNv = withVec $ \case [a, b, c] -> (,,) <$> parseEDN a <*> parseEDN b <*> parseEDN c _ -> - fail "vector of size 3 expected" + DP.parserError "vector of size 3 expected" instance (FromEDN a, FromEDN b, FromEDN c, FromEDN d) => FromEDN (a, b, c, d) where parseEDNv = withVec $ \case [a, b, c, d] -> (,,,) <$> parseEDN a <*> parseEDN b <*> parseEDN c <*> parseEDN d _ -> - fail "vector of size 3 expected" + DP.parserError "vector of size 3 expected" instance FromEDN UTCTime where parseEDN tv = parseTaggedUTCTime tv <|> parseUntaggedUTCTime tv @@ -483,7 +486,7 @@ parseUUID t = case UUID.fromText t of Nothing -> - fail "invalid UUID string" + DP.parserError "invalid UUID string" Just uuid -> pure uuid diff --git a/lib/Data/EDN/Class/Parser.hs b/lib/Data/EDN/Class/Parser.hs --- a/lib/Data/EDN/Class/Parser.hs +++ b/lib/Data/EDN/Class/Parser.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE RankNTypes #-} -- | Generic continuation-based parser @@ -10,6 +11,7 @@ , Failure , Expected , Label + , parserError ) where import Control.Applicative (Alternative(..)) @@ -20,7 +22,7 @@ import qualified Data.List as List -- | Run a 'Parser' reporting to arbitrary 'Monad' with 'fail'. -parseM :: Monad m => (a -> Parser b) -> a -> m b +parseM :: Fail.MonadFail m => (a -> Parser b) -> a -> m b parseM p v = runParser (p v) (unexpected fail) pure -- | Run a 'Parser' reporting to an 'Either'. @@ -95,9 +97,7 @@ {-# INLINE (<|>) #-} instance Fail.MonadFail Parser where - fail msg = - Parser $ \kf _ks -> - kf mempty msg + fail = parserError {-# INLINE fail #-} instance Monad Parser where @@ -112,8 +112,11 @@ return = pure {-# INLINE return #-} +#if MIN_VERSION_base(4,12,0) +#else fail = Fail.fail {-# INLINE fail #-} +#endif instance MonadPlus Parser where mzero = fail "mzero" @@ -131,3 +134,8 @@ mappend = (<>) {-# INLINE mappend #-} + +parserError :: String -> Parser a +parserError msg = Parser $ \kf _ks -> + kf mempty msg +{-# INLINE parserError #-} diff --git a/lib/Data/EDN/QQ.hs b/lib/Data/EDN/QQ.hs --- a/lib/Data/EDN/QQ.hs +++ b/lib/Data/EDN/QQ.hs @@ -39,9 +39,13 @@ edn :: QuasiQuoter edn = ednQQ $ \str -> do src <- fmap loc_filename qLocation - tv <- parseText src (Text.pack str) - lift tv + case parseText src (Text.pack str) of + Right val -> + lift val + Left err -> + error err + -- | Quasiquoter for untagged 'Value' wrapped in a List. -- -- @ @@ -52,9 +56,16 @@ ednList :: QuasiQuoter ednList = ednQQ $ \str -> do src <- fmap loc_filename qLocation - NoTag tv <- parseText src $ "(" <> Text.pack str <> ")" - lift tv + let doc = "(" <> Text.pack str <> ")" + case parseText src doc of + Right (NoTag tv) -> + lift tv + Right Tagged{} -> + error "unexpected tagged value" + Left err -> + error err + -- | Quasiquoter for untagged 'Value' wrapped in a Vec. -- -- @ @@ -65,9 +76,16 @@ ednVec :: QuasiQuoter ednVec = ednQQ $ \str -> do src <- fmap loc_filename qLocation - NoTag tv <- parseText src $ "[" <> Text.pack str <> "]" - lift tv + let doc = "[" <> Text.pack str <> "]" + case parseText src doc of + Right (NoTag tv) -> + lift tv + Right Tagged{} -> + error "unexpected tagged value" + Left err -> + error err + -- | Quasiquoter for untagged 'Value' wrapped in a Set. -- -- @ @@ -78,9 +96,16 @@ ednSet :: QuasiQuoter ednSet = ednQQ $ \str -> do src <- fmap loc_filename qLocation - NoTag tv <- parseText src $ "#{" <> Text.pack str <> "}" - lift tv + let doc = "#{" <> Text.pack str <> "}" + case parseText src doc of + Right (NoTag tv) -> + lift tv + Right Tagged{} -> + error "unexpected tagged value" + Left err -> + error err + -- | Quasiquoter for untagged 'Value' wrapped in a Map. -- -- @ @@ -91,9 +116,16 @@ ednMap :: QuasiQuoter ednMap = ednQQ $ \str -> do src <- fmap loc_filename qLocation - NoTag tv <- parseText src $ "{" <> Text.pack str <> "}" - lift tv + let doc = "{" <> Text.pack str <> "}" + case parseText src doc of + Right (NoTag tv) -> + lift tv + Right Tagged{} -> + error "unexpected tagged value" + Left err -> + error err + -- | Specializable QuasiQuoter for compile-time decoding. -- -- > ednPerson = fromEDN @Person @@ -104,8 +136,11 @@ fromEDN :: forall a. (Lift a, FromEDN a) => QuasiQuoter fromEDN = ednQQ $ \str -> do src <- fmap loc_filename qLocation - val <- decodeText src (Text.pack str) :: Q a - lift val + case decodeText src (Text.pack str) of + Left err -> + error err + Right (val :: a) -> + lift val ednQQ :: (String -> Q Exp) -> QuasiQuoter ednQQ qexp = QuasiQuoter diff --git a/tests/Data/EDN/AST/Test.hs b/tests/Data/EDN/AST/Test.hs --- a/tests/Data/EDN/AST/Test.hs +++ b/tests/Data/EDN/AST/Test.hs @@ -30,14 +30,14 @@ prop_regr_empty_containers :: Property prop_regr_empty_containers = withTests 1 . property $ do - emptyList <- EDN.parseText "" "( )" + emptyList <- either fail pure $ EDN.parseText "" "( )" emptyList === EDN.NoTag (EDN.List mempty) - emptyVec <- EDN.parseText "" "[ ]" + emptyVec <- either fail pure $ EDN.parseText "" "[ ]" emptyVec === EDN.NoTag (EDN.Vec mempty) - emptySet <- EDN.parseText "" "#{ }" + emptySet <- either fail pure $ EDN.parseText "" "#{ }" emptySet === EDN.NoTag (EDN.Set mempty) - emptyMap <- EDN.parseText "" "{ }" + emptyMap <- either fail pure $ EDN.parseText "" "{ }" emptyMap === EDN.NoTag (EDN.Map mempty) diff --git a/tests/Data/EDN/Class/Test.hs b/tests/Data/EDN/Class/Test.hs --- a/tests/Data/EDN/Class/Test.hs +++ b/tests/Data/EDN/Class/Test.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} @@ -34,7 +35,7 @@ codecExample :: forall a. (ToEDN a, FromEDN a, Eq a, Show a) => Text -> a -> Example codecExample encoded value = withTests 1 . property $ do - tripping value toEDN (fromEDN :: EDN.TaggedValue -> Either String a) + tripping value toEDN fromEDN EDN.renderText (toEDN value) === encoded -- * Atomic types @@ -136,7 +137,11 @@ prop_tagged_utctime :: Example prop_tagged_utctime = codecExample +#if MIN_VERSION_time(1,9,3) + "#inst \"1985-04-12T23:20:50.52UTC\"" +#else "#inst \"1985-04-12T23:20:50.52Z\"" +#endif (parseTimeOrError False defaultTimeLocale @@ -179,5 +184,6 @@ prop_unexpected :: Property prop_unexpected = property $ do - uuid <- EDN.decodeText "Test.hs:184" "#uuid \"f81d4fae-7dec-11d0-a765-00a0c91e6bf6\"" + uuid <- either fail pure $ + EDN.decodeText "Test.hs:184" "#uuid \"f81d4fae-7dec-11d0-a765-00a0c91e6bf6\"" uuid === (read "f81d4fae-7dec-11d0-a765-00a0c91e6bf6" :: UUID)