Script 'mail_helper' called by obssrc Hello community, here is the log from the commit of package ghc-lift-type for openSUSE:Factory checked in at 2024-07-31 13:30:22 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-lift-type (Old) and /work/SRC/openSUSE:Factory/.ghc-lift-type.new.7232 (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-lift-type" Wed Jul 31 13:30:22 2024 rev:4 rq:1190547 version:0.1.2.0 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-lift-type/ghc-lift-type.changes 2023-04-04 21:21:23.073524584 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-lift-type.new.7232/ghc-lift-type.changes 2024-07-31 13:30:49.867591353 +0200 @@ -1,0 +2,8 @@ +Tue Jul 23 00:03:37 UTC 2024 - Peter Simons <psimons@suse.com> + +- Update lift-type to version 0.1.2.0. + ## 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) + +------------------------------------------------------------------- Old: ---- lift-type-0.1.1.1.tar.gz New: ---- lift-type-0.1.2.0.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-lift-type.spec ++++++ --- /var/tmp/diff_new_pack.M0nFNr/_old 2024-07-31 13:30:50.627622565 +0200 +++ /var/tmp/diff_new_pack.M0nFNr/_new 2024-07-31 13:30:50.627622565 +0200 @@ -1,7 +1,7 @@ # # spec file for package ghc-lift-type # -# Copyright (c) 2023 SUSE LLC +# Copyright (c) 2024 SUSE LLC # # All modifications and additions to the file contributed by third parties # remain the property of their copyright owners, unless otherwise agreed @@ -20,7 +20,7 @@ %global pkgver %{pkg_name}-%{version} %bcond_with tests Name: ghc-%{pkg_name} -Version: 0.1.1.1 +Version: 0.1.2.0 Release: 0 Summary: Lift a type from a Typeable constraint to a Template Haskell type License: BSD-3-Clause @@ -33,6 +33,10 @@ BuildRequires: ghc-template-haskell-devel BuildRequires: ghc-template-haskell-prof ExcludeArch: %{ix86} +%if %{with tests} +BuildRequires: ghc-hspec-devel +BuildRequires: ghc-hspec-prof +%endif %description Lift your types from a Typeable constraint to a Template Haskell type. ++++++ lift-type-0.1.1.1.tar.gz -> lift-type-0.1.2.0.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/lift-type-0.1.1.1/ChangeLog.md new/lift-type-0.1.2.0/ChangeLog.md --- old/lift-type-0.1.1.1/ChangeLog.md 2022-11-24 19:42:10.000000000 +0100 +++ new/lift-type-0.1.2.0/ChangeLog.md 2024-07-23 02:03:35.000000000 +0200 @@ -1,5 +1,9 @@ # 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) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/lift-type-0.1.1.1/lift-type.cabal new/lift-type-0.1.2.0/lift-type.cabal --- old/lift-type-0.1.1.1/lift-type.cabal 2022-11-24 19:42:10.000000000 +0100 +++ new/lift-type-0.1.2.0/lift-type.cabal 2024-07-23 02:03:35.000000000 +0200 @@ -1,6 +1,6 @@ cabal-version: 1.12 name: lift-type -version: 0.1.1.1 +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 @@ -39,4 +39,6 @@ base , lift-type , template-haskell + , hspec + , ghc-prim default-language: Haskell2010 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/lift-type-0.1.1.1/src/LiftType.hs new/lift-type-0.1.2.0/src/LiftType.hs --- old/lift-type-0.1.1.1/src/LiftType.hs 2022-11-24 19:42:10.000000000 +0100 +++ new/lift-type-0.1.2.0/src/LiftType.hs 2024-07-23 02:03:35.000000000 +0200 @@ -32,6 +32,39 @@ 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 @@ -62,6 +95,8 @@ let tcName = tyConName tyCon + typeOrDataName = + tyConToName tyCon trySymbol = case tcName of '"' : cs -> @@ -69,72 +104,97 @@ _ -> 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) + case typeOrDataName of + PromotedDataName name -> + 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 + ConT (getTypeOrDataName typeOrDataName) 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) --- @ +-- | 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. -- --- This works with data kinds, too. +-- >>> 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. -- --- @ --- >>> :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.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.0.0 -liftType :: forall t. Typeable t => Type -liftType = - typeRepToType (SomeTypeRep (typeRep @t)) +-- @since 0.1.2.0 +getTypeOrDataName :: TypeOrDataName -> Name +getTypeOrDataName d = + case d of + TypeName n -> + n + PromotedDataName n -> + n diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/lift-type-0.1.1.1/test/Spec.hs new/lift-type-0.1.2.0/test/Spec.hs --- old/lift-type-0.1.1.1/test/Spec.hs 2022-11-24 19:42:10.000000000 +0100 +++ new/lift-type-0.1.2.0/test/Spec.hs 2024-07-23 02:03:35.000000000 +0200 @@ -1,11 +1,17 @@ -{-# language MagicHash, TemplateHaskell, DataKinds, TypeApplications #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} module Main where -import LiftType -import Data.Proxy import Data.Kind +import Data.Proxy import GHC.Exts +import LiftType +import Test.Hspec +import GHC.Prim main :: IO () main = do @@ -24,4 +30,29 @@ plainTuple = (Proxy :: Proxy $(liftTypeQ @(Int, Char))) == Proxy @(Int, Char) symbol = Proxy :: Proxy $(liftTypeQ @"hello") isTrue2 = symbol == Proxy @"hello" - putStrLn "should compile" + + 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