diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -3,6 +3,38 @@ All notable changes to this project will be documented in this file. This project adheres to [Semantic Versioning](http://semver.org/). +## [0.3.0.4] - 2021-11-13 + +- Compatiblity with prettyprinter-1.7.1 deprecactions. + +## [0.3.0.3] - 2011-06-19 + +- GHC 9.0 support. + +## [0.3.0.2] - 2020-11-17 + +- Add liftTyped methods for template-haskell 2.16 + +## [0.3.0.1] - 2020-03-21 + +- GHC 8.8 warnings fixed + +## [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 +93,11 @@ - Use utf8-string parsing for unicode literals. +[0.3.0.4]: https://gitlab.com/dpwiz/hedn/tree/v0.3.0.4 +[0.3.0.3]: https://gitlab.com/dpwiz/hedn/tree/v0.3.0.3 +[0.3.0.2]: https://gitlab.com/dpwiz/hedn/tree/v0.3.0.2 +[0.3.0.1]: https://gitlab.com/dpwiz/hedn/tree/v0.3.0.1 +[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 @@ -1,13 +1,13 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.31.1. +-- This file has been generated from package.yaml by hpack version 0.34.4. -- -- see: https://github.com/sol/hpack -- --- hash: 3422cbfa0f065b597c1a18d7b765dcd6ddddbea6b62aceab67212f90c480a468 +-- hash: 784b8e18f38a2e70046c5ec03603dd229e8486d61fad1a326af0f647adfa1102 name: hedn -version: 0.2.0.1 +version: 0.3.0.4 synopsis: EDN parsing and encoding description: A EDN parsing and encoding library. . @@ -18,13 +18,13 @@ 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.5, GHC==8.8.3, GHC==8.10.4, GHC==9.0.1, GHC==9.2.1 build-type: Simple extra-source-files: CHANGELOG.md LICENSE README.md - example.edn source-repository head type: git @@ -48,14 +48,14 @@ lib ghc-options: -Wall build-depends: - base >=4.9 && <4.13 + base >=4.9 && <5 , containers >=0.5.7 && <0.7 , deepseq >=1.4 && <2 - , deriving-compat >=0.3.6 && <0.6 - , megaparsec >=7.0 && <8 + , deriving-compat >=0.3.6 && <0.7 + , megaparsec >=7.0 && <10 , parser-combinators >=1.0 && <2 , prettyprinter >=1.2 && <2 - , scientific >=0.3 && <0.4 + , scientific ==0.3.* , template-haskell >=2.11 && <3 , text >=1.2 && <2 , time >=1.6 && <2 @@ -77,11 +77,11 @@ tests ghc-options: -Wall build-depends: - base >=4.9 && <4.13 + base >=4.9 && <5 , containers >=0.5.7 && <0.7 - , hedgehog >=0.6 && <0.7 - , hedn >=0.2 && <1 - , megaparsec >=7.0 && <8 + , hedgehog >=0.6 && <2 + , hedn + , megaparsec >=7.0 && <10 , text >=1.2 && <2 , time >=1.6 && <2 , uuid-types >=1.0 && <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 @@ -89,7 +85,7 @@ P.choice [ parseNil , parseBool - , P.try parseNumber + , parseNumber , parseSymbol , parseCharacter , parseString @@ -189,7 +185,7 @@ plain = P.anySingleBut '"' parseNumber :: Parser Value -parseNumber = P.try parseFloating <|> parseInteger +parseNumber = P.try parseFloating <|> P.try parseInteger where parseFloating = Floating <$> L.floating parseInteger = Integer <$> L.integer diff --git a/lib/Data/EDN/AST/Printer.hs b/lib/Data/EDN/AST/Printer.hs --- a/lib/Data/EDN/AST/Printer.hs +++ b/lib/Data/EDN/AST/Printer.hs @@ -1,4 +1,5 @@ -{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} module Data.EDN.AST.Printer @@ -9,15 +10,24 @@ import Data.Char (ord) import Data.Foldable (toList) +#if MIN_VERSION_base(4,13,0) +#else import Data.Semigroup ((<>)) +#endif import Data.Text (Text) -import Data.Text.Prettyprint.Doc (Doc, pretty, (<+>)) import Text.Printf (printf) import qualified Data.Map as Map import qualified Data.Text as Text +#if MIN_VERSION_prettyprinter(1,7,1) +import Prettyprinter (Doc, pretty, (<+>)) +import qualified Prettyprinter as PP +import qualified Prettyprinter.Render.Text as PP +#else +import Data.Text.Prettyprint.Doc (Doc, pretty, (<+>)) import qualified Data.Text.Prettyprint.Doc as PP import qualified Data.Text.Prettyprint.Doc.Render.Text as PP +#endif import qualified Data.EDN.AST.Types as EDN 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,17 +11,21 @@ , Failure , Expected , Label + , parserError ) where import Control.Applicative (Alternative(..)) import Control.Monad (MonadPlus(..)) +#if MIN_VERSION_base(4,13,0) +#else import Data.Semigroup (Semigroup(..)) +#endif import qualified Control.Monad.Fail as Fail 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 +100,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 +115,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 +137,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 @@ -1,10 +1,11 @@ {-# LANGUAGE AllowAmbiguousTypes #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} -- XXX: Lift instances. Don't want to pollute main module with TH shenanigans. {-# OPTIONS_GHC -fno-warn-orphans #-} @@ -19,14 +20,18 @@ ) where import Data.Data (Data) +#if MIN_VERSION_base(4,13,0) +#else import Data.Semigroup ((<>)) +#endif import Data.Text (Text) import Data.Typeable (cast) import Language.Haskell.TH.Quote (QuasiQuoter(..)) -import Language.Haskell.TH.Syntax (Exp(..), Lift(..), Q, dataToExpQ, loc_filename, qLocation) +import Language.Haskell.TH.Syntax (Exp(..), Lift(..), Q) import qualified Data.Text as Text import qualified Data.Vector as Vector +import qualified Language.Haskell.TH.Syntax as TH import Data.EDN (FromEDN, decodeText, parseText) import Data.EDN.AST.Types (Tagged(..), Value(..)) @@ -38,10 +43,14 @@ -- @ edn :: QuasiQuoter edn = ednQQ $ \str -> do - src <- fmap loc_filename qLocation - tv <- parseText src (Text.pack str) - lift tv + src <- fmap TH.loc_filename TH.qLocation + case parseText src (Text.pack str) of + Right val -> + lift val + Left err -> + error err + -- | Quasiquoter for untagged 'Value' wrapped in a List. -- -- @ @@ -51,10 +60,17 @@ -- @ ednList :: QuasiQuoter ednList = ednQQ $ \str -> do - src <- fmap loc_filename qLocation - NoTag tv <- parseText src $ "(" <> Text.pack str <> ")" - lift tv + src <- fmap TH.loc_filename TH.qLocation + 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. -- -- @ @@ -64,10 +80,17 @@ -- @ ednVec :: QuasiQuoter ednVec = ednQQ $ \str -> do - src <- fmap loc_filename qLocation - NoTag tv <- parseText src $ "[" <> Text.pack str <> "]" - lift tv + src <- fmap TH.loc_filename TH.qLocation + 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. -- -- @ @@ -77,10 +100,17 @@ -- @ ednSet :: QuasiQuoter ednSet = ednQQ $ \str -> do - src <- fmap loc_filename qLocation - NoTag tv <- parseText src $ "#{" <> Text.pack str <> "}" - lift tv + src <- fmap TH.loc_filename TH.qLocation + 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. -- -- @ @@ -90,10 +120,17 @@ -- @ ednMap :: QuasiQuoter ednMap = ednQQ $ \str -> do - src <- fmap loc_filename qLocation - NoTag tv <- parseText src $ "{" <> Text.pack str <> "}" - lift tv + src <- fmap TH.loc_filename TH.qLocation + 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 @@ -103,9 +140,12 @@ -- > theFred = [ednPerson| #myapp/Person { :first "Fred" } |] 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 + src <- fmap TH.loc_filename TH.qLocation + case decodeText src (Text.pack str) of + Left err -> + error err + Right (val :: a) -> + lift val ednQQ :: (String -> Q Exp) -> QuasiQuoter ednQQ qexp = QuasiQuoter @@ -117,12 +157,28 @@ -- XXX: Workaround for Text.pack not present in the same module with Text constructors. -- See https://stackoverflow.com/a/38182444 +#if MIN_VERSION_base(4,15,0) +liftData' :: (Data a, TH.Quote m) => a -> m Exp +#else liftData' :: Data a => a -> Q Exp -liftData' = dataToExpQ $ fmap liftText . cast +#endif +liftData' = TH.dataToExpQ $ fmap liftText . cast +#if MIN_VERSION_base(4,15,0) +liftText :: TH.Quote m => Text.Text -> m Exp +#else liftText :: Text.Text -> Q Exp +#endif liftText txt = AppE (VarE 'Text.pack) <$> lift (Text.unpack txt) +#if MIN_VERSION_base(4,15,0) +liftVector :: (Lift a, TH.Quote m) => Vector.Vector a -> m Exp +#else +liftVector :: Lift a => Vector.Vector a -> Q Exp +#endif +liftVector vec = + AppE (VarE 'Vector.fromList) <$> lift (Vector.toList vec) + -- XXX: Workaround for undefined toConstr in Data instance for Vector. instance Data a => Lift (Tagged Text a) where lift = \case @@ -135,6 +191,12 @@ val' <- liftData' val pure $ ConE 'Tagged `AppE` tagNS' `AppE` tag' `AppE` val' +#if MIN_VERSION_template_haskell(2,17,0) + liftTyped = TH.unsafeCodeCoerce . lift +#elif MIN_VERSION_template_haskell(2,16,0) + liftTyped = TH.unsafeTExpCoerce . lift +#endif + instance Lift Value where lift = \case Vec items -> @@ -142,6 +204,8 @@ val -> liftData' val -liftVector :: Lift a => Vector.Vector a -> Q Exp -liftVector vec = - AppE (VarE 'Vector.fromList) <$> lift (Vector.toList vec) +#if MIN_VERSION_template_haskell(2,17,0) + liftTyped = TH.unsafeCodeCoerce . lift +#elif MIN_VERSION_template_haskell(2,16,0) + liftTyped = TH.unsafeTExpCoerce . lift +#endif diff --git a/tests/Data/EDN/AST/Gen.hs b/tests/Data/EDN/AST/Gen.hs --- a/tests/Data/EDN/AST/Gen.hs +++ b/tests/Data/EDN/AST/Gen.hs @@ -13,7 +13,7 @@ import qualified Hedgehog.Gen as Gen import qualified Hedgehog.Range as Range -import qualified Data.EDN.AST.Parser as EDN +import qualified Data.EDN.AST.Parser as Parser import qualified Data.EDN.AST.Types as EDN genTaggedValue :: Gen EDN.TaggedValue @@ -40,7 +40,7 @@ withoutTag = EDN.NoTag <$> gen genTagIdent :: Gen Text -genTagIdent = genText EDN.tagChars +genTagIdent = genText Parser.tagChars genValue :: Gen EDN.Value genValue = Gen.recursive Gen.choice atomic collections @@ -93,7 +93,7 @@ <$> genKeywordName genKeywordName :: Gen Text -genKeywordName = genTextInitial EDN.keywordInitialChars EDN.keywordChars +genKeywordName = genTextInitial Parser.keywordInitialChars Parser.keywordChars genSymbol :: Gen EDN.Value genSymbol = EDN.Symbol @@ -101,7 +101,7 @@ <*> genSymbolName genSymbolName :: Gen Text -genSymbolName = genTextInitial EDN.symbolInitialChars EDN.symbolChars +genSymbolName = genTextInitial Parser.symbolInitialChars Parser.symbolChars genSet :: Gen EDN.Value genSet = EDN.mkSet 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)