lift-type-0.1.1.1/src/0000755000000000000000000000000014337735402012552 5ustar0000000000000000lift-type-0.1.1.1/test/0000755000000000000000000000000014337735402012742 5ustar0000000000000000lift-type-0.1.1.1/src/LiftType.hs0000644000000000000000000001011514337735402014644 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 -- | '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 trySymbol = case tcName of '"' : cs -> Just $ LitT (StrTyLit (zipWith const cs (drop 1 cs))) _ -> Nothing tryTicked = case tcName of '\'' : dcName -> let nameBase = mkOccName dcName flavor = NameG DataName (mkPkgName $ tyConPackage tyCon) (mkModName $ tyConModule tyCon) name = Name nameBase flavor in Just (PromotedT name) _ -> Nothing tryNat = LitT . NumTyLit <$> readMaybe tcName plainType = let nameBase = mkOccName tcName flavor = NameG TcClsName (mkPkgName $ tyConPackage tyCon) (mkModName $ tyConModule tyCon) name = Name nameBase flavor in ConT name in fromMaybe plainType $ asum [tryTicked, trySymbol, tryNat] -- | 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)) lift-type-0.1.1.1/test/Spec.hs0000644000000000000000000000170614337735402014174 0ustar0000000000000000{-# language MagicHash, TemplateHaskell, DataKinds, TypeApplications #-} module Main where import LiftType import Data.Proxy import Data.Kind import GHC.Exts 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" putStrLn "should compile" lift-type-0.1.1.1/LICENSE0000644000000000000000000000277114337237173013001 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.1.1/Setup.hs0000644000000000000000000000005614337237173013422 0ustar0000000000000000import Distribution.Simple main = defaultMain lift-type-0.1.1.1/lift-type.cabal0000644000000000000000000000210714337735402014664 0ustar0000000000000000cabal-version: 1.12 name: lift-type version: 0.1.1.1 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 default-language: Haskell2010 lift-type-0.1.1.1/README.md0000644000000000000000000000025314337237173013244 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.1.1/ChangeLog.md0000644000000000000000000000101314337735402014127 0ustar0000000000000000# Changelog for lift-typeable ## 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