diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,8 +1,12 @@ -0.3.0 ------ +0.3.1 [2021.12.02] +------------------ +* Switch to using th-compat to support GHC 9.0 and 9.2 + +0.3.0 [2019.01.10] +------------------ * New implementation, forces use of Lift for the result, removes the unsafe typeclass functions, and adds the option to add a custom error message. -0.2.0.1 -------- +0.2.0.1 [2018.09.10] +-------------------- * Turn examples into buildable tests, add readme, fix typos in documentation. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -2,6 +2,7 @@ ================================================================ [![BSD3](https://img.shields.io/badge/License-BSD-blue.svg)](https://en.wikipedia.org/wiki/BSD_License) [![Hackage](https://img.shields.io/hackage/v/validated-literals.svg)](https://hackage.haskell.org/package/validated-literals) +[![hackage-ci](https://matrix.hackage.haskell.org/api/v2/packages/validated-literals/badge)](https://matrix.hackage.haskell.org/#/package/validated-literals) [![Build Status](https://travis-ci.org/merijn/validated-literals.svg)](https://travis-ci.org/merijn/validated-literals) To disallow invalid input it is common to define (new)types with hidden data diff --git a/ValidLiterals.hs b/ValidLiterals.hs --- a/ValidLiterals.hs +++ b/ValidLiterals.hs @@ -1,7 +1,7 @@ ------------------------------------------------------------------------------- -- | -- Module : ValidLiterals --- Copyright : (C) 2015-2019 Merijn Verstraaten +-- Copyright : (C) 2015-2021 Merijn Verstraaten -- License : BSD-style (see the file LICENSE) -- Maintainer : Merijn Verstraaten -- Stability : experimental @@ -50,10 +50,10 @@ ) where import Control.Exception (Exception(displayException), throwIO) -import Data.Maybe (maybe) import Data.Proxy (Proxy(Proxy)) import Data.Typeable (Typeable) import Language.Haskell.TH.Syntax +import Language.Haskell.TH.Syntax.Compat (Splice, liftSplice) -- | 'Exception' type for failed conversions. Useful for testing and more -- gracefully handling compile time failures. @@ -84,8 +84,8 @@ -- avoiding the need for orphan 'Lift' instances and allowing complex -- splices for types that can't be directly lifted. See the 'ByteString' -- example module for an example. - liftResult :: Proxy a -> b -> Q (TExp b) - default liftResult :: Lift b => Proxy a -> b -> Q (TExp b) + liftResult :: Proxy a -> b -> Splice Q b + default liftResult :: Lift b => Proxy a -> b -> Splice Q b liftResult _ val = [|| val ||] -- | The core function of ValidLiterals, use this together with Typed Template @@ -108,10 +108,10 @@ -- x :: ASCII -- x = $$(valid \'c\') -- @ -valid :: forall a b . Validate a b => a -> Q (TExp b) +valid :: forall a b . Validate a b => a -> Splice Q b valid input = case fromLiteralWithError input of Right result -> liftResult (Proxy :: Proxy a) result - Left err -> do + Left err -> liftSplice $ do reportError $ unlines [ "Invalid input used for type-safe validated literal!", err ] runIO $ throwIO (ValidationFailure err) @@ -122,7 +122,7 @@ -- -- Since 'Integral' literals use @fromInteger :: Num a => Integer -> a@ this -- function cannot cost you any precision. -validInteger :: Validate Integer b => Integer -> Q (TExp b) +validInteger :: Validate Integer b => Integer -> Splice Q b validInteger = valid -- | Same as 'validInteger', but for 'Fractional' values. @@ -130,15 +130,15 @@ -- Since 'Fractional' literals use -- @fromRational :: Fractional a => Rational -> a@ this function cannot cost -- you any precision. -validRational :: Validate Rational b => Rational -> Q (TExp b) +validRational :: Validate Rational b => Rational -> Splice Q b validRational = valid -- | Same as 'validInteger', but for when enabling @OverloadedStrings@ makes -- 'String' literals polymorphic. -validString :: Validate String b => String -> Q (TExp b) +validString :: Validate String b => String -> Splice Q b validString = valid -- | Same as 'validInteger', but for when enabling @OverloadedLists@ makes list -- literals polymorphic. -validList :: Validate [a] b => [a] -> Q (TExp b) +validList :: Validate [a] b => [a] -> Splice Q b validList = valid diff --git a/examples/ByteString.hs b/examples/ByteString.hs --- a/examples/ByteString.hs +++ b/examples/ByteString.hs @@ -1,4 +1,5 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} +{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TemplateHaskell #-} @@ -18,5 +19,11 @@ where nonAsciiVals = filter (not . (<=255) . ord) s + -- As of template-haskell-2.16.0.0 we no longer need to rely on the hack of + -- unsafeTExpCoerce! +#if MIN_VERSION_template_haskell(2,16,0) + liftResult _ v = [|| BS.pack $$(liftTyped (BS.unpack v)) ||] +#else liftResult _ v = unsafeTExpCoerce $ AppE <$> [| BS.pack |] <*> lift (BS.unpack v) +#endif diff --git a/examples/Examples.hs b/examples/Examples.hs --- a/examples/Examples.hs +++ b/examples/Examples.hs @@ -5,7 +5,8 @@ import Control.Exception (Exception(..), SomeException(..), bracket_, evaluate, try) import GHC.IO.Handle (hDuplicate, hDuplicateTo) -import Language.Haskell.TH (Q, TExp, runQ) +import Language.Haskell.TH (Q, runQ) +import Language.Haskell.TH.Syntax.Compat (Splice, examineSplice) import System.IO (IOMode(WriteMode), stderr, hFlush, withFile) import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit (assertFailure, testCase) @@ -15,10 +16,10 @@ import Even import ByteString -failingEven :: Q (TExp Even) +failingEven :: Splice Q Even failingEven = validInteger 39 -failingByteString :: Q (TExp ByteString) +failingByteString :: Splice Q ByteString failingByteString = valid "λ" evenVal :: Even @@ -40,9 +41,9 @@ oldStderr <- hDuplicate stderr bracket_ (hDuplicateTo nullHnd stderr) (hDuplicateTo oldStderr stderr) act -checkTHFails :: String -> Q a -> TestTree +checkTHFails :: String -> Splice Q a -> TestTree checkTHFails name thExpr = testCase name $ do - result <- try . withRedirectedStderr $ runQ thExpr + result <- try . withRedirectedStderr . runQ $ examineSplice thExpr case result of Right _ -> assertFailure "TH didn't fail!" Left e | Just ValidationFailure{} <- fromException e -> return () diff --git a/validated-literals.cabal b/validated-literals.cabal --- a/validated-literals.cabal +++ b/validated-literals.cabal @@ -1,20 +1,21 @@ +Cabal-Version: 2.0 Name: validated-literals -Version: 0.3.0 +Version: 0.3.1 Homepage: https://github.com/merijn/validated-literals Bug-Reports: https://github.com/merijn/validated-literals/issues Author: Merijn Verstraaten Maintainer: Merijn Verstraaten -Copyright: Copyright © 2015-2018 Merijn Verstraaten +Copyright: Copyright © 2015-2021 Merijn Verstraaten License: BSD3 License-File: LICENSE Category: Data -Cabal-Version: >= 1.10 Build-Type: Simple -Tested-With: GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.3 +Tested-With: GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.5, + GHC == 8.8.4, GHC == 8.10.7, GHC == 9.0.1, GHC == 9.2.1 Synopsis: Compile-time checking for partial smart-constructors @@ -56,8 +57,9 @@ Exposed-Modules: ValidLiterals - Build-Depends: base >= 4.9 && < 4.13 - , template-haskell + Build-Depends: base >= 4.9 && < 4.17 + , template-haskell >= 2.11 && < 2.19 + , th-compat ^>= 0.1.3 Test-Suite examples Default-Language: Haskell2010 @@ -67,21 +69,18 @@ Even GHC-Options: -Wall -fno-warn-unused-do-bind - Other-Extensions: DeriveGeneric, DeriveLift, FlexibleInstances, + Other-Extensions: CPP, DeriveGeneric, DeriveLift, FlexibleInstances, MultiParamTypeClasses, TemplateHaskell Hs-Source-Dirs: examples Build-Depends: base - , bytestring == 0.10.* + , bytestring >= 0.10 && < 0.12 , deepseq == 1.4.* - , tasty >= 0.11 && < 1.2 - , tasty-hunit == 0.9.* + , tasty >= 0.11 && < 1.5 + , tasty-hunit >= 0.9 && < 0.11 , tasty-travis >= 0.2 && < 0.3 , template-haskell + , th-compat , validated-literals - -Source-Repository head - Type: mercurial - Location: https://bitbucket.org/merijnv/validated-literals Source-Repository head Type: git