th-utilities 0.2.5.0 → 0.2.5.1

raw patch · 4 files changed

+81/−6 lines, 4 filesdep +th-liftdep ~template-haskell

Dependencies added: th-lift

Dependency ranges changed: template-haskell

Files

• ChangeLog.md +7/−0
• src/TH/Utilities.hs +25/−2
• test/TH/UtilitiesSpec.hs +43/−0
• th-utilities.cabal +6/−4

@@ -1,5 +1,12 @@ # ChangeLog +## 0.2.5.1++* `typeRepToType` now supports type literals, tuples and lists. See+  [#18][]++[#18]: https://github.com/fpco/th-utilities/pull/18+ ## 0.2.5.0  * Adds `tupT` and `promotedTupT`.

@@ -1,6 +1,8 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-} {-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeApplications #-} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE RankNTypes #-}@@ -16,6 +18,7 @@ import Language.Haskell.TH import Language.Haskell.TH.Syntax import Language.Haskell.TH.Datatype.TyVarBndr (TyVarBndr_, tvName)+import Text.Read (readMaybe) import TH.FixQ (fixQ)  -- | Get the 'Name' of a 'TyVarBndr'@@ -177,9 +180,29 @@ typeRepToType :: TypeRep -> Q Type typeRepToType tr = do     let (con, args) = splitTyConApp tr-        name = Name (OccName (tyConName con)) (NameG TcClsName (PkgName (tyConPackage con)) (ModName (tyConModule con)))+        modName = tyConModule con+        name pn mn cn = Name (OccName cn) (NameG TcClsName (PkgName pn) (ModName mn))+        conName = tyConName con+        t | modName == tupleMod = TupleT $ length args+          | modName == listMod && conName == listCon = ListT+          | modName == typeLitsMod =+              case tyConName con of+                s@('"':_) -> LitT . StrTyLit $ read s+#if MIN_VERSION_template_haskell(2,17,0)+                ['\'', c, '\''] -> LitT $ CharTyLit c+#endif+                s -> case readMaybe s of+                    Just n -> LitT $ NumTyLit n+                    _ -> error $ "Unrecognized type literal name: " ++ s+          | otherwise = ConT $ name (tyConPackage con) modName conName     resultArgs <- mapM typeRepToType args-    return (appsT (ConT name) resultArgs)+    return (appsT t resultArgs)+  where+    typeLitsMod = tyConModule . typeRepTyCon . typeRep $ Proxy @42+    tupleMod = tyConModule . typeRepTyCon . typeRep $ Proxy @((), ())+    listMod = tyConModule . typeRepTyCon . typeRep $ Proxy @[()]+    listCon = tyConName . typeRepTyCon . typeRep $ Proxy @[()]+  -- | Hack to enable putting expressions inside 'lift'-ed TH data. For -- example, you could do

@@ -0,0 +1,43 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TemplateHaskell #-}++module TH.UtilitiesSpec where++import Data.Typeable+import Language.Haskell.TH as TH+import Language.Haskell.TH.Instances ()+import Language.Haskell.TH.Lift+import Test.Hspec as HS+import TH.Utilities+++spec :: Spec+spec = do+  describe "TH.Utilities.typeRepToType" $ do+    it "Int" $ do+      tr (Proxy @Int) `shouldReturn` $( lift =<< [t| Int |] )+    it "Bool" $ do+      tr (Proxy @Bool) `shouldReturn` $( lift =<< [t| Bool |] )+    it "Maby Int" $ do+      tr (Proxy @(Maybe Int)) `shouldReturn` $(lift =<< [t| Maybe Int |])+    it "[Int]" $ do+      tr (Proxy @[Int]) `shouldReturn` $(lift =<< [t| [Int] |])+    it "(Bool,Int)" $ do+      tr (Proxy @(Bool, Int)) `shouldReturn` $(lift =<< [t| (Bool, Int) |])+    it "()" $ do+      tr (Proxy @()) `shouldReturn` $(lift =<< [t| () |])+    it "42" $ do+      tr (Proxy @42) `shouldReturn` $(lift =<< [t| 42 |])+#if MIN_VERSION_template_haskell(2,17,0)+    it "'c'" $ do+      tr (Proxy @'c') `shouldReturn` $(lift =<< [t| 'c' |])+#endif+    it "str" $ do+      tr (Proxy @"hello \"world") `shouldReturn` $(lift =<< [t| "hello \"world" |])+  where+    tr :: forall a. Typeable a => Proxy a -> IO Type+    tr p = runQ (typeRepToType (typeRep p))

@@ -1,11 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.34.4.+-- This file has been generated from package.yaml by hpack version 0.37.0. -- -- see: https://github.com/sol/hpack  name:           th-utilities-version:        0.2.5.0+version:        0.2.5.1 synopsis:       Collection of useful functions for use with Template Haskell category:       Template Haskell homepage:       https://github.com/fpco/th-utilities#readme@@ -44,7 +44,7 @@     , filepath     , primitive     , syb-    , template-haskell >=2.7+    , template-haskell >=2.8     , text     , th-abstraction >=0.4     , th-orphans@@ -57,6 +57,7 @@       TH.Derive.StorableSpec       TH.DeriveSpec       TH.DeriveSpec.TH+      TH.UtilitiesSpec       Paths_th_utilities   hs-source-dirs:       test@@ -70,9 +71,10 @@     , hspec     , primitive     , syb-    , template-haskell >=2.7+    , template-haskell >=2.8     , text     , th-abstraction >=0.4+    , th-lift     , th-orphans     , th-utilities     , vector