product-isomorphic 0.0.3.1 → 0.0.3.2
raw patch · 3 files changed
+72/−8 lines, 3 filesdep +product-isomorphicdep ~basePVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependencies added: product-isomorphic
Dependency ranges changed: base
API changes (from Hackage documentation)
- Data.Functor.ProductIsomorphic.TupleInstances: instance Data.Functor.ProductIsomorphic.Unsafe.ProductConstructor (a0 -> b0 -> (a0, b0))
- Data.Functor.ProductIsomorphic.TupleInstances: instance Data.Functor.ProductIsomorphic.Unsafe.ProductConstructor (a0 -> b0 -> c0 -> (a0, b0, c0))
- Data.Functor.ProductIsomorphic.TupleInstances: instance Data.Functor.ProductIsomorphic.Unsafe.ProductConstructor (a0 -> b0 -> c0 -> d0 -> (a0, b0, c0, d0))
- Data.Functor.ProductIsomorphic.TupleInstances: instance Data.Functor.ProductIsomorphic.Unsafe.ProductConstructor (a0 -> b0 -> c0 -> d0 -> e0 -> (a0, b0, c0, d0, e0))
- Data.Functor.ProductIsomorphic.TupleInstances: instance Data.Functor.ProductIsomorphic.Unsafe.ProductConstructor (a0 -> b0 -> c0 -> d0 -> e0 -> f0 -> (a0, b0, c0, d0, e0, f0))
- Data.Functor.ProductIsomorphic.TupleInstances: instance Data.Functor.ProductIsomorphic.Unsafe.ProductConstructor (a0 -> b0 -> c0 -> d0 -> e0 -> f0 -> g0 -> (a0, b0, c0, d0, e0, f0, g0))
+ Data.Functor.ProductIsomorphic.TupleInstances: instance Data.Functor.ProductIsomorphic.Unsafe.ProductConstructor (a -> b -> (a, b))
+ Data.Functor.ProductIsomorphic.TupleInstances: instance Data.Functor.ProductIsomorphic.Unsafe.ProductConstructor (a -> b -> c -> (a, b, c))
+ Data.Functor.ProductIsomorphic.TupleInstances: instance Data.Functor.ProductIsomorphic.Unsafe.ProductConstructor (a -> b -> c -> d -> (a, b, c, d))
+ Data.Functor.ProductIsomorphic.TupleInstances: instance Data.Functor.ProductIsomorphic.Unsafe.ProductConstructor (a -> b -> c -> d -> e -> (a, b, c, d, e))
+ Data.Functor.ProductIsomorphic.TupleInstances: instance Data.Functor.ProductIsomorphic.Unsafe.ProductConstructor (a -> b -> c -> d -> e -> f -> (a, b, c, d, e, f))
+ Data.Functor.ProductIsomorphic.TupleInstances: instance Data.Functor.ProductIsomorphic.Unsafe.ProductConstructor (a -> b -> c -> d -> e -> f -> g -> (a, b, c, d, e, f, g))
Files
- product-isomorphic.cabal +16/−3
- src/Data/Functor/ProductIsomorphic/TH/Internal.hs +21/−5
- test/doTH.hs +35/−0
product-isomorphic.cabal view
@@ -1,5 +1,5 @@ name: product-isomorphic-version: 0.0.3.1+version: 0.0.3.2 synopsis: Weaken applicative functor on products description: Weaken applicative functor which allows only product construction. Product constructions and deconstructions@@ -14,7 +14,8 @@ build-type: Simple -- extra-source-files: cabal-version: >=1.10-tested-with: GHC == 8.2.1+tested-with: GHC == 8.4.1, GHC == 8.4.2+ , GHC == 8.2.1, GHC == 8.2.2 , GHC == 8.0.1, GHC == 8.0.2 , GHC == 7.10.1, GHC == 7.10.2, GHC == 7.10.3 , GHC == 7.8.1, GHC == 7.8.2, GHC == 7.8.3, GHC == 7.8.4@@ -35,7 +36,7 @@ other-modules: Data.Functor.ProductIsomorphic.TH.Internal - build-depends: base <5+ build-depends: base >=4.5 && <5 , template-haskell , th-data-compat if impl(ghc == 7.4.*)@@ -44,6 +45,18 @@ default-language: Haskell2010 ghc-options: -Wall +test-suite th+ build-depends: base <5+ , template-haskell+ , product-isomorphic++ type: exitcode-stdio-1.0+ main-is: doTH.hs++ hs-source-dirs: test+ ghc-options: -Wall++ default-language: Haskell2010 source-repository head type: git
src/Data/Functor/ProductIsomorphic/TH/Internal.hs view
@@ -3,7 +3,7 @@ -- | -- Module : Data.Functor.ProductIsomorphic.TH.Internal--- Copyright : 2017 Kei Hibino+-- Copyright : 2017-2018 Kei Hibino -- License : BSD3 -- -- Maintainer : ex8k.hibino@gmail.com@@ -17,11 +17,12 @@ reifyRecordType, ) where +import Control.Applicative ((<|>)) import Language.Haskell.TH (Q, Name, tupleTypeName, Info (..), reify, TypeQ, arrowT, appT, conT, varT,- Dec, ExpQ, conE, Con (..), TyVarBndr (..), )-import Language.Haskell.TH.Compat.Data (unDataD)+ Dec, ExpQ, conE, Con (..), TyVarBndr (..), nameBase,)+import Language.Haskell.TH.Compat.Data (unDataD, unNewtypeD) import Data.List (foldl') import Data.Functor.ProductIsomorphic.Unsafe (ProductConstructor (..))@@ -30,7 +31,12 @@ recordInfo' :: Info -> Maybe (((TypeQ, [Name]), ExpQ), (Maybe [Name], [TypeQ])) recordInfo' = d where d (TyConI tcon) = do- (_cxt, tcn, bs, _mk, [r], _ds) <- unDataD tcon+ (tcn, bs, r) <-+ do (_cxt, tcn, bs, _mk, [r], _ds) <- unDataD tcon+ Just (tcn, bs, r)+ <|>+ do (_cxt, tcn, bs, _mk, r , _ds) <- unNewtypeD tcon+ Just (tcn, bs, r) let vns = map getTV bs case r of NormalC dcn ts -> Just (((buildT tcn vns, vns), conE dcn), (Nothing, [return t | (_, t) <- ts]))@@ -46,9 +52,19 @@ reifyRecordType :: Name -> Q (((TypeQ, [Name]), ExpQ), (Maybe [Name], [TypeQ])) reifyRecordType recTypeName = maybe- (fail $ "Defined record type constructor not found: " ++ show recTypeName)+ (fail msgOnErr) return . recordInfo' =<< reify recTypeName+ where+ recTypeNameS = show recTypeName+ recTypeNameB = nameBase recTypeName+ msgOnErr =+ "Valid record type constructor not found: " ++ recTypeNameS ++ ".\n"+ ++ " Possible causes:\n"+ ++ " - " ++ recTypeNameB ++ " is not a type name.\n"+ ++ " (Type name must be prefixed with double-single-quotes: e.g. ''" ++ recTypeNameB ++ ")\n"+ ++ " - " ++ recTypeNameB ++ " has multiple data constructors.\n"+ ++ " (Currently, only types with exactly *one* data constructors are supported)\n" -- | Make template of ProductConstructor instance from type constructor name. defineProductConstructor :: Name -- ^ name of product or record type constructor
+ test/doTH.hs view
@@ -0,0 +1,35 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE FlexibleInstances #-}++import Language.Haskell.TH (runIO)++import Data.Functor.ProductIsomorphic.TH+ (reifyRecordType, defineProductConstructor)+++newtype NNormal = NNormal Int+newtype NRec = NRec { _nrec :: Int }+data DNormal = DNormal Int+data DRec = DRec { _drec :: Int }++-- expect compilation error on test failure+$(mapM_ (\(tn, dn) -> do+ runIO . putStrLn $ "testing " ++ show (tn, dn)+ --- (((TypeQ, [Name]), ExpQ), (Maybe [Name], [TypeQ]))+ (((tq, vns), eq), (fns, ftqs)) <- reifyRecordType tn+ ty <- tq+ expr <- eq+ fts <- sequence ftqs+ runIO $ print (((ty, vns), expr), (fns, fts))+ )+ [(''NNormal, 'NNormal), (''NRec, 'NRec),+ (''DNormal, 'DNormal), (''DRec, 'DRec)]+ >> return [])++$(defineProductConstructor ''NNormal)+$(defineProductConstructor ''NRec)+$(defineProductConstructor ''DNormal)+$(defineProductConstructor ''DRec)++main :: IO ()+main = return ()