lift-type-0.1.2.0/src/0000755000000000000000000000000014647571527012564 5ustar0000000000000000lift-type-0.1.2.0/test/0000755000000000000000000000000014647571527012754 5ustar0000000000000000lift-type-0.1.2.0/src/LiftType.hs0000644000000000000000000001307014647571527014661 0ustar0000000000000000{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeInType #-} {-# LANGUAGE TypeOperators #-} -- | Template Haskell has a class 'Lift' that allows you to promote values -- from Haskell-land into the land of metaprogramming - 'Q'. -- -- @ -- class 'Lift' a where -- 'lift' :: a -> 'Q' 'Exp' -- -- 'liftTyped' :: a -> 'Q' ('TExp' a) -- @ -- -- However, there wasn't a way to promote a *type* into a @'Q' 'Type'@. -- -- This library provides exactly that function. It requires a 'Typeable' -- constraint, but this is automatically satisfied by GHC. -- -- @since 0.1.0.0 module LiftType where import Data.Foldable (asum) import qualified Data.Kind as Kind import Data.Maybe (fromMaybe) import Language.Haskell.TH.Syntax import Text.Read (readMaybe) import Type.Reflection -- | Convert a type argument into a Template Haskell 'Type'. -- -- Use with @TypeApplications@. -- -- Example: -- -- @ -- >>> :set -XTypeApplications -- >>> liftType \@Bool -- ConT GHC.Types.Bool -- >>> liftType \@[Char] -- AppT (ConT GHC.Types.[]) (ConT GHC.Types.Char) -- @ -- -- This works with data kinds, too. -- -- @ -- >>> :set -XDataKinds -- >>> liftType \@3 -- LitT (NumTyLit 3) -- >>> liftType \@"hello" -- LitT (StrTyLit "hello") -- >>> liftType \@'[Int, Char] -- AppT (AppT (PromotedT GHC.Types.:) (ConT GHC.Types.Int)) (AppT (AppT (PromotedT GHC.Types.:) (ConT GHC.Types.Char)) (PromotedT GHC.Types.[])) -- >>> liftType \@'(Int, Char) -- AppT (AppT (PromotedT GHC.Tuple.(,)) (ConT GHC.Types.Int)) (ConT GHC.Types.Char) -- @ -- -- @since 0.1.0.0 liftType :: forall t. Typeable t => Type liftType = typeRepToType (SomeTypeRep (typeRep @t)) -- | 'liftType' promoted to the 'Q' monad. -- -- @since 0.1.0.0 liftTypeQ :: forall t. Typeable t => Q Type liftTypeQ = pure $ liftType @t -- | Promote a 'SomeTypeRep' into a 'Type'. -- -- @since 0.1.1.0 typeRepToType :: SomeTypeRep -> Type typeRepToType (SomeTypeRep a) = go a where go :: forall k (a :: k). TypeRep a -> Type go tr | Just HRefl <- eqTypeRep (typeRep @Kind.Type) tr = ConT ''Kind.Type | otherwise = case tr of Con tyCon -> mk tyCon Fun trA trB -> ConT ''(->) `AppT` go trA `AppT` go trB App trA trB -> AppT (go trA) (go trB) mk :: TyCon -> Type mk tyCon = let tcName = tyConName tyCon typeOrDataName = tyConToName tyCon trySymbol = case tcName of '"' : cs -> Just $ LitT (StrTyLit (zipWith const cs (drop 1 cs))) _ -> Nothing tryTicked = case typeOrDataName of PromotedDataName name -> Just (PromotedT name) _ -> Nothing tryNat = LitT . NumTyLit <$> readMaybe tcName plainType = ConT (getTypeOrDataName typeOrDataName) in fromMaybe plainType $ asum [tryTicked, trySymbol, tryNat] -- | Extract the 'TypeOrDataName' from a 'TyCon'. You probably want to use -- 'typeToName' instead. See that function for documentation and more -- information. -- -- @since 0.1.2.0 tyConToName :: TyCon -> TypeOrDataName tyConToName tyCon = let tcName = tyConName tyCon tryTicked = case tcName of '\'' : dcName -> let nameBase = mkOccName dcName flavor = NameG DataName (mkPkgName $ tyConPackage tyCon) (mkModName $ tyConModule tyCon) name = Name nameBase flavor in Just (PromotedDataName name) _ -> Nothing plainType = let nameBase = mkOccName tcName flavor = NameG TcClsName (mkPkgName $ tyConPackage tyCon) (mkModName $ tyConModule tyCon) name = Name nameBase flavor in TypeName name in fromMaybe plainType tryTicked -- | This function returns the name of the outermost type constructor. -- -- >>> typeToName @Char -- TypeName ''Char -- >>> typeToName @Maybe -- TypeName ''Maybe -- >>> typeToName @(Maybe Char) -- TypeName ''Maybe -- >>> typeToName @(Int -> Char) -- TypeName ''(->) -- >>> typeToName @'False -- PromotedDataName 'False -- -- @since 0.1.2.0 typeToName :: forall t. Typeable t => TypeOrDataName typeToName = tyConToName (typeRepTyCon (typeRep @t)) -- | It's possible to use a data constructor with a @DataKinds@ promotion. -- This disambiguates where the name comes from. -- -- @since 0.1.2.0 data TypeOrDataName = TypeName Name | PromotedDataName Name deriving (Show, Eq) -- | Retrieve the 'Name' from a 'TypeOrDataName', forgetting how it was -- parsed. -- -- @since 0.1.2.0 getTypeOrDataName :: TypeOrDataName -> Name getTypeOrDataName d = case d of TypeName n -> n PromotedDataName n -> n lift-type-0.1.2.0/test/Spec.hs0000644000000000000000000000405514647571527014206 0ustar0000000000000000{-# LANGUAGE DataKinds #-} {-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeApplications #-} module Main where import Data.Kind import Data.Proxy import GHC.Exts import LiftType import Test.Hspec import GHC.Prim main :: IO () main = do let type_ = Proxy :: Proxy $(liftTypeQ @Type) type_' = Proxy :: Proxy $(liftTypeQ @TYPE) word# = Proxy :: Proxy $(liftTypeQ @Word#) bool = Proxy :: Proxy $(liftTypeQ @Bool) true = Proxy :: Proxy $(liftTypeQ @'True) three = Proxy :: Proxy $(liftTypeQ @3) valList = Proxy :: Proxy $(liftTypeQ @[Char]) isTrue = valList == Proxy @[Char] list = Proxy :: Proxy $(liftTypeQ @'[Int, Char]) tuple = Proxy :: Proxy $(liftTypeQ @'(Int, Char)) isTrueTuple = tuple == Proxy @'(Int, Char) plainTuple = (Proxy :: Proxy $(liftTypeQ @(Int, Char))) == Proxy @(Int, Char) symbol = Proxy :: Proxy $(liftTypeQ @"hello") isTrue2 = symbol == Proxy @"hello" hspec $ do describe "LiftType" $ do describe "typeToName" $ do it "returns function arrow on functions" $ do #if __GLASGOW_HASKELL__ >= 900 typeToName @(Int -> Char) `shouldBe` TypeName ''GHC.Prim.FUN #else typeToName @(Int -> Char) `shouldBe` TypeName ''(->) #endif it "works on a plain type" $ do typeToName @Char `shouldBe` TypeName ''Char it "works on Maybe" $ do typeToName @Maybe `shouldBe` TypeName ''Maybe it "works on a class" $ do typeToName @Functor `shouldBe` TypeName ''Functor it "pulls the outermost type constructor" $ do typeToName @(Maybe Int) `shouldBe` TypeName ''Maybe it "works on a ticked constructor" $ do typeToName @'False `shouldBe` PromotedDataName 'False assert :: String -> Bool -> IO () assert msg cond = if cond then pure () else error msg lift-type-0.1.2.0/LICENSE0000644000000000000000000000277114647476111013002 0ustar0000000000000000Copyright Author name here (c) 2021 All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Author name here nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. lift-type-0.1.2.0/Setup.hs0000644000000000000000000000005614647476111013423 0ustar0000000000000000import Distribution.Simple main = defaultMain lift-type-0.1.2.0/lift-type.cabal0000644000000000000000000000214214647571527014675 0ustar0000000000000000cabal-version: 1.12 name: lift-type version: 0.1.2.0 description: Lift your types from a Typeable constraint to a Template Haskell type synopsis: Lift a type from a Typeable constraint to a Template Haskell type homepage: https://github.com/parsonsmatt/lift-type#readme bug-reports: https://github.com/parsonsmatt/lift-type/issues author: Matt Parsons maintainer: parsonsmatt@gmail.com copyright: 2021 Matt Parsons license: BSD3 license-file: LICENSE build-type: Simple extra-source-files: README.md ChangeLog.md source-repository head type: git location: https://github.com/parsonsmatt/lift-type library exposed-modules: LiftType hs-source-dirs: src build-depends: base >= 4.10 && <5 , template-haskell default-language: Haskell2010 test-suite lift-type-test type: exitcode-stdio-1.0 main-is: Spec.hs hs-source-dirs: test ghc-options: -threaded -rtsopts -with-rtsopts=-N build-depends: base , lift-type , template-haskell , hspec , ghc-prim default-language: Haskell2010 lift-type-0.1.2.0/README.md0000644000000000000000000000025314647476111013245 0ustar0000000000000000# lift-type This library provides a utility function `liftType` which accepts a type application argument and returns the `Template Haskell` `Type` representation of it. lift-type-0.1.2.0/ChangeLog.md0000644000000000000000000000124314647571527014146 0ustar0000000000000000# Changelog for lift-typeable ## 0.1.2.0 - Add `typeToName`, making it possible to accurately extract a `Name` from a type. [#11](https://github.com/parsonsmatt/lift-type/pull/11) ## 0.1.1.1 - Fix lifting the `Data.Kind.Type` into a `TemplateHaskell.Type` [#9](https://github.com/parsonsmatt/lift-type/pull/9) ## 0.1.1.0 - Cleanup and a slight performance improvement [#7](https://github.com/parsonsmatt/lift-type/pull/7) - Implement `typeRepToType :: SomeTypeRep -> Type` [#8](https://github.com/parsonsmatt/lift-type/pull/8) ## 0.1.0.1 - Support GHC 8.2.2, which evidently required `TypeInType` for the `forall k (a :: k)` signature. ## 0.1.0.0 - Initial release