th-instance-reification 0.1.4 → 0.1.5
raw patch · 7 files changed
+175/−270 lines, 7 filesdep +QuickCheckdep +quickcheck-instancesdep +rerebasedep −HTFdep −loch-thdep −placeholdersdep ~basedep ~containersdep ~list-extras
Dependencies added: QuickCheck, quickcheck-instances, rerebase, tasty, tasty-hunit, tasty-quickcheck, th-instance-reification
Dependencies removed: HTF, loch-th, placeholders
Dependency ranges changed: base, containers, list-extras, template-haskell, th-expand-syns
Files
- src/HTFTestSuite.hs +0/−71
- src/HTFTestSuite/Prerequisites.hs +0/−11
- src/THInstanceReification.hs +3/−3
- src/THInstanceReification/Prelude/Basic.hs +58/−47
- test/Main.hs +64/−0
- test/Main/Prerequisites.hs +11/−0
- th-instance-reification.cabal +39/−138
− src/HTFTestSuite.hs
@@ -1,71 +0,0 @@-{-# OPTIONS_GHC -F -pgmF htfpp #-}--import Test.Framework-import THInstanceReification.Prelude.Basic-import THInstanceReification.Prelude.TH-import THInstanceReification-import HTFTestSuite.Prerequisites---main = htfMain $ htf_thisModulesTests----test_existingInstance = do- assertBool $ read $( do- t <- [t| (Int, Int) |]- r <- isProperInstance ''Show [t]- stringE $ show $ r- )--test_nonExistingInstance = do- assertBool $ not $ read $( do- t <- [t| (Int, A) |]- r <- isProperInstance ''Show [t]- stringE $ show $ r- )--test_existingInstanceOnMultiParamClass = do- assertBool $ read $( do- int <- [t|Int|]- char <- [t|Char|]- stringE . show =<< isProperInstance ''MultiParamClass [int, int, char]- )--test_nonExistingInstanceOnMultiParamClass = do- assertBool $ not $ read $( do- int <- [t|Int|]- char <- [t|Char|]- a <- [t|A|]- stringE . show =<< isProperInstance ''MultiParamClass [a, int, char]- )---test_compositeTypes = do- assertBool $ read $( do- t <- [t|(Int, Char, Char)|]- stringE . show =<< isProperInstance ''Show [t]- )--test_compositeTypesMultiParam = do- assertBool $ read $( do- t <- [t|(Int, Char, Char)|]- int <- [t|Int|]- char <- [t|Char|]- stringE . show =<< isProperInstance ''MultiParamClass [t, int, char]- )---test_polyTypes = do- assertBool $ read $( do- t <- [t|(B Char)|]- stringE . show =<< isProperInstance ''Show [t]- )--test_synonyms = do- assertBool $ read $( do- t <- [t|C|]- stringE . show =<< isProperInstance ''Show [t]- )--
− src/HTFTestSuite/Prerequisites.hs
@@ -1,11 +0,0 @@-module HTFTestSuite.Prerequisites where--import Prelude--data A = A-newtype B a = B a deriving (Show)-type C = (B Int, B Char)---class MultiParamClass a b c-instance (Eq a) => MultiParamClass a Int Char
src/THInstanceReification.hs view
@@ -36,7 +36,7 @@ -- It simply considers them to be true. typesSatisfyDecConstraints :: [Type] -> InstanceDec -> Q Bool typesSatisfyDecConstraints tl = \case- InstanceD context instanceType _ -> do+ InstanceD _ context instanceType _ -> do let ([ConT n], htl) = splitAt 1 $ reverse $ unapplyType instanceType -- Expand type synonyms in type signatures, -- using 'expandSyns' from the "th-expand-syns" library:@@ -63,7 +63,7 @@ actualTypeByVarName :: Name -> Type actualTypeByVarName = \n -> Map.lookup n m ?: - ($bug $ "Unexpected key: " <> show n <> ", in a map: " <> show m)+ (error $ "Unexpected key: " <> show n <> ", in a map: " <> show m) where -- A memoization cache. m = Map.fromList $ concat $ map accRecords $ typeAssocs@@ -75,7 +75,7 @@ accRecords = \case (AppT al ar, AppT hl hr) -> accRecords (al, hl) ++ accRecords (ar, hr) (a, VarT n) -> [(n, a)]- (a, h) | a /= h -> $bug $ "Unmatching types: " <> show a <> ", " <> show h+ (a, h) | a /= h -> error $ "Unmatching types: " <> show a <> ", " <> show h _ -> [] -- | -- Test a predicate by substituting all type vars with associated
src/THInstanceReification/Prelude/Basic.hs view
@@ -2,10 +2,6 @@ ( module Exports, - traceM,- bug,- bottom,- (?:), (|>), (<|),@@ -14,61 +10,76 @@ where -- base-import Prelude as Exports hiding (concat, foldr, mapM_, sequence_, foldl1, maximum, minimum, product, sum, all, and, any, concatMap, elem, foldl, foldr1, notElem, or, mapM, sequence, FilePath, id, (.))-import Control.Monad as Exports hiding (mapM_, sequence_, forM_, msum, mapM, sequence, forM) import Control.Applicative as Exports-import Control.Arrow as Exports hiding (left, right)+import Control.Arrow as Exports hiding (first, second) import Control.Category as Exports-import Data.Monoid as Exports-import Data.Foldable as Exports-import Data.Traversable as Exports hiding (for)-import Data.Maybe as Exports+import Control.Concurrent as Exports+import Control.Exception as Exports+import Control.Monad as Exports hiding (fail, mapM_, sequence_, forM_, msum, mapM, sequence, forM)+import Control.Monad.IO.Class as Exports+import Control.Monad.Fail as Exports+import Control.Monad.Fix as Exports hiding (fix)+import Control.Monad.ST as Exports+import Data.Bifunctor as Exports+import Data.Bits as Exports+import Data.Bool as Exports+import Data.Char as Exports+import Data.Coerce as Exports+import Data.Complex as Exports+import Data.Data as Exports+import Data.Dynamic as Exports import Data.Either as Exports-import Data.List as Exports hiding (concat, foldr, foldl1, maximum, minimum, product, sum, all, and, any, concatMap, elem, foldl, foldr1, notElem, or, find, maximumBy, minimumBy, mapAccumL, mapAccumR, foldl')-import Data.Tuple as Exports-import Data.Ord as Exports (Down(..))-import Data.String as Exports-import Data.Int as Exports-import Data.Word as Exports-import Data.Ratio as Exports import Data.Fixed as Exports+import Data.Foldable as Exports hiding (toList)+import Data.Function as Exports hiding (id, (.))+import Data.Functor as Exports+import Data.Functor.Identity as Exports+import Data.Int as Exports+import Data.IORef as Exports import Data.Ix as Exports-import Data.Data as Exports-import Text.Read as Exports (readMaybe, readEither)-import Control.Exception as Exports hiding (tryJust, try, assert)-import Control.Concurrent as Exports hiding (yield)-import System.Mem.StableName as Exports-import System.Timeout as Exports+import Data.List as Exports hiding (sortOn, isSubsequenceOf, uncons, concat, foldr, foldl1, maximum, minimum, product, sum, all, and, any, concatMap, elem, foldl, foldr1, notElem, or, find, maximumBy, minimumBy, mapAccumL, mapAccumR, foldl')+import Data.Maybe as Exports+import Data.Monoid as Exports hiding (Last(..), First(..), (<>))+import Data.Ord as Exports+import Data.Proxy as Exports+import Data.Ratio as Exports+import Data.Semigroup as Exports+import Data.STRef as Exports+import Data.String as Exports+import Data.Traversable as Exports+import Data.Tuple as Exports+import Data.Unique as Exports+import Data.Version as Exports+import Data.Void as Exports+import Data.Word as Exports+import Debug.Trace as Exports+import Foreign.ForeignPtr as Exports+import Foreign.Ptr as Exports+import Foreign.StablePtr as Exports+import Foreign.Storable as Exports hiding (sizeOf, alignment)+import GHC.Conc as Exports hiding (withMVar, threadWaitWriteSTM, threadWaitWrite, threadWaitReadSTM, threadWaitRead)+import GHC.Exts as Exports (lazy, inline, sortWith, groupWith, IsList(..))+import GHC.Generics as Exports (Generic, Generic1)+import GHC.IO.Exception as Exports+import Numeric as Exports+import Prelude as Exports hiding (fail, concat, foldr, mapM_, sequence_, foldl1, maximum, minimum, product, sum, all, and, any, concatMap, elem, foldl, foldr1, notElem, or, mapM, sequence, id, (.))+import System.Environment as Exports import System.Exit as Exports-import System.IO.Unsafe as Exports-import System.IO as Exports (Handle, hClose)+import System.IO as Exports import System.IO.Error as Exports+import System.IO.Unsafe as Exports+import System.Mem as Exports+import System.Mem.StableName as Exports+import System.Timeout as Exports+import Text.ParserCombinators.ReadP as Exports (ReadP, ReadS, readP_to_S, readS_to_P)+import Text.ParserCombinators.ReadPrec as Exports (ReadPrec, readPrec_to_P, readP_to_Prec, readPrec_to_S, readS_to_Prec)+import Text.Printf as Exports (printf, hPrintf)+import Text.Read as Exports (Read(..), readMaybe, readEither) import Unsafe.Coerce as Exports-import GHC.Exts as Exports hiding (Any, traceEvent, traceM, toList)-import GHC.Generics as Exports (Generic)-import GHC.IO.Exception as Exports-import Data.IORef as Exports-import Data.STRef as Exports-import Control.Monad.ST as Exports-import Debug.Trace as Exports hiding (traceM) --- placeholders-import Development.Placeholders as Exports- -- list-extras import Data.List.Extras as Exports --import qualified Debug.Trace.LocationTH--traceM :: (Monad m) => String -> m ()-traceM s = trace s $ return ()--bug = [e| $(Debug.Trace.LocationTH.failure) . (msg <>) |]- where- msg = "A \"th-instance-reification\" package bug: " :: String--bottom = [e| $bug "Bottom evaluated" |] (?:) :: Maybe a -> a -> a maybeA ?: b = fromMaybe b maybeA
+ test/Main.hs view
@@ -0,0 +1,64 @@+module Main where++import Prelude+import Test.QuickCheck.Instances+import Test.Tasty+import Test.Tasty.Runners+import Test.Tasty.HUnit+import Test.Tasty.QuickCheck+import Language.Haskell.TH+import THInstanceReification+import Main.Prerequisites+import qualified Test.QuickCheck as QuickCheck+import qualified Test.QuickCheck.Property as QuickCheck+++main = defaultMain $ testGroup "" $ [+ testCase "existingInstance" $ do+ assertBool "" $ read $( do+ t <- [t| (Int, Int) |]+ r <- isProperInstance ''Show [t]+ stringE $ show $ r+ ),+ testCase "nonExistingInstance" $ do+ assertBool "" $ not $ read $( do+ t <- [t| (Int, A) |]+ r <- isProperInstance ''Show [t]+ stringE $ show $ r+ ),+ testCase "existingInstanceOnMultiParamClass" $ do+ assertBool "" $ read $( do+ int <- [t|Int|]+ char <- [t|Char|]+ stringE . show =<< isProperInstance ''MultiParamClass [int, int, char]+ ),+ testCase "nonExistingInstanceOnMultiParamClass" $ do+ assertBool "" $ not $ read $( do+ int <- [t|Int|]+ char <- [t|Char|]+ a <- [t|A|]+ stringE . show =<< isProperInstance ''MultiParamClass [a, int, char]+ ),+ testCase "compositeTypes" $ do+ assertBool "" $ read $( do+ t <- [t|(Int, Char, Char)|]+ stringE . show =<< isProperInstance ''Show [t]+ ),+ testCase "compositeTypesMultiParam" $ do+ assertBool "" $ read $( do+ t <- [t|(Int, Char, Char)|]+ int <- [t|Int|]+ char <- [t|Char|]+ stringE . show =<< isProperInstance ''MultiParamClass [t, int, char]+ ),+ testCase "polyTypes" $ do+ assertBool "" $ read $( do+ t <- [t|(B Char)|]+ stringE . show =<< isProperInstance ''Show [t]+ ),+ testCase "synonyms" $ do+ assertBool "" $ read $( do+ t <- [t|C|]+ stringE . show =<< isProperInstance ''Show [t]+ )+ ]
+ test/Main/Prerequisites.hs view
@@ -0,0 +1,11 @@+module Main.Prerequisites where++import Prelude++data A = A+newtype B a = B a deriving (Show)+type C = (B Int, B Char)+++class MultiParamClass a b c+instance (Eq a) => MultiParamClass a Int Char
th-instance-reification.cabal view
@@ -1,156 +1,57 @@-name:- th-instance-reification-version:- 0.1.4-synopsis:- Fixed versions of instances reification functions+name: th-instance-reification+version: 0.1.5+synopsis: Fixed versions of instances reification functions description: Provides fixed versions of 'reifyInstances' and 'isInstance' as per the following ghc issue: <https://ghc.haskell.org/trac/ghc/ticket/7066>.-category:- Template Haskell-homepage:- https://github.com/nikita-volkov/th-instance-reification -bug-reports:- https://github.com/nikita-volkov/th-instance-reification/issues -author:- Nikita Volkov <nikita.y.volkov@mail.ru>-maintainer:- Nikita Volkov <nikita.y.volkov@mail.ru>-copyright:- (c) 2014, Nikita Volkov-license:- MIT-license-file:- LICENSE-build-type:- Simple-cabal-version:- >=1.10-+category: Template Haskell+homepage: https://github.com/nikita-volkov/th-instance-reification+bug-reports: https://github.com/nikita-volkov/th-instance-reification/issues+author: Nikita Volkov <nikita.y.volkov@mail.ru>+maintainer: Nikita Volkov <nikita.y.volkov@mail.ru>+copyright: (c) 2014, Nikita Volkov+license: MIT+license-file: LICENSE+build-type: Simple+cabal-version: >=1.10 source-repository head- type:- git- location:- git://github.com/nikita-volkov/th-instance-reification.git-+ type: git+ location: git://github.com/nikita-volkov/th-instance-reification.git library- hs-source-dirs:- src+ hs-source-dirs: src+ exposed-modules:+ THInstanceReification other-modules: THInstanceReification.Prelude.Basic THInstanceReification.Prelude.TH- exposed-modules:- THInstanceReification build-depends:- -- data:- containers >= 0.4 && < 0.6,- -- debugging:- loch-th == 0.2.*,- placeholders == 0.1.*,- -- template-haskell:- th-expand-syns == 0.3.*,- template-haskell < 2.11,- -- general:- list-extras == 0.4.*,- base >= 4.6 && < 5- default-extensions:- Arrows- BangPatterns- ConstraintKinds- DataKinds- DefaultSignatures- DeriveDataTypeable- DeriveGeneric- EmptyDataDecls- FlexibleContexts- FlexibleInstances- FunctionalDependencies- GADTs- GeneralizedNewtypeDeriving- ImpredicativeTypes- LambdaCase- LiberalTypeSynonyms- MultiParamTypeClasses- MultiWayIf- NoImplicitPrelude- NoMonomorphismRestriction- OverloadedStrings- PatternGuards- QuasiQuotes- RankNTypes- RecordWildCards- ScopedTypeVariables- StandaloneDeriving- TemplateHaskell- TupleSections- TypeFamilies- TypeOperators- default-language:- Haskell2010-+ base >=4.9 && <5,+ containers >=0.6 && <0.7,+ list-extras ==0.4.*,+ template-haskell >=2.11 && <2.16,+ th-expand-syns ==0.4.*+ default-extensions: Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveGeneric, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators+ default-language: Haskell2010 test-suite th-instance-reification-htf-test-suite- type: - exitcode-stdio-1.0- hs-source-dirs: - src- main-is: - HTFTestSuite.hs+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Main.hs other-modules:- HTFTestSuite.Prerequisites- ghc-options:- -threaded- "-with-rtsopts=-N"+ Main.Prerequisites+ ghc-options: -threaded "-with-rtsopts=-N" build-depends:- -- testing:- HTF == 0.12.*,- -- data:- containers,- -- debugging:- loch-th == 0.2.*,- placeholders == 0.1.*,- -- template-haskell:- th-expand-syns,+ QuickCheck >=2.13 && <3,+ quickcheck-instances >=0.3.22 && <0.4,+ rerebase ==1.*,+ tasty >=1.2.3 && <2,+ tasty-hunit >=0.10.0.2 && <0.11,+ tasty-quickcheck >=0.10.1 && <0.11, template-haskell,- -- general:- list-extras,- base- default-extensions:- Arrows- BangPatterns- ConstraintKinds- DataKinds- DefaultSignatures- DeriveDataTypeable- DeriveGeneric- EmptyDataDecls- FlexibleContexts- FlexibleInstances- FunctionalDependencies- GADTs- GeneralizedNewtypeDeriving- ImpredicativeTypes- LambdaCase- LiberalTypeSynonyms- MultiParamTypeClasses- MultiWayIf- NoImplicitPrelude- NoMonomorphismRestriction- OverloadedStrings- PatternGuards- QuasiQuotes- RankNTypes- RecordWildCards- ScopedTypeVariables- StandaloneDeriving- TemplateHaskell- TupleSections- TypeFamilies- TypeOperators- default-language:- Haskell2010+ th-instance-reification+ default-extensions: Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveGeneric, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators+ default-language: Haskell2010