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 2023-01-18 13:10:04
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/ghc-lift-type (Old)
 and      /work/SRC/openSUSE:Factory/.ghc-lift-type.new.32243 (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

Package is "ghc-lift-type"

Wed Jan 18 13:10:04 2023 rev:2 rq:1059081 version:0.1.1.1

Changes:
--------
--- /work/SRC/openSUSE:Factory/ghc-lift-type/ghc-lift-type.changes      
2021-05-11 23:04:10.892951889 +0200
+++ /work/SRC/openSUSE:Factory/.ghc-lift-type.new.32243/ghc-lift-type.changes   
2023-01-18 13:10:21.824661965 +0100
@@ -1,0 +2,13 @@
+Thu Nov 24 18:42:13 UTC 2022 - Peter Simons <[email protected]>
+
+- Update lift-type to version 0.1.1.1.
+  ## 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)
+
+-------------------------------------------------------------------

Old:
----
  lift-type-0.1.0.1.tar.gz

New:
----
  lift-type-0.1.1.1.tar.gz

++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

Other differences:
------------------
++++++ ghc-lift-type.spec ++++++
--- /var/tmp/diff_new_pack.CW2uYN/_old  2023-01-18 13:10:22.640666802 +0100
+++ /var/tmp/diff_new_pack.CW2uYN/_new  2023-01-18 13:10:22.648666849 +0100
@@ -1,7 +1,7 @@
 #
 # spec file for package ghc-lift-type
 #
-# Copyright (c) 2021 SUSE LLC
+# Copyright (c) 2022 SUSE LLC
 #
 # All modifications and additions to the file contributed by third parties
 # remain the property of their copyright owners, unless otherwise agreed
@@ -19,7 +19,7 @@
 %global pkg_name lift-type
 %bcond_with tests
 Name:           ghc-%{pkg_name}
-Version:        0.1.0.1
+Version:        0.1.1.1
 Release:        0
 Summary:        Lift a type from a Typeable constraint to a Template Haskell 
type
 License:        BSD-3-Clause

++++++ lift-type-0.1.0.1.tar.gz -> lift-type-0.1.1.1.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' 
'--exclude=.svnignore' old/lift-type-0.1.0.1/ChangeLog.md 
new/lift-type-0.1.1.1/ChangeLog.md
--- old/lift-type-0.1.0.1/ChangeLog.md  2021-04-24 00:39:05.000000000 +0200
+++ new/lift-type-0.1.1.1/ChangeLog.md  2022-11-24 19:42:10.000000000 +0100
@@ -1,5 +1,14 @@
 # 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.
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' 
'--exclude=.svnignore' old/lift-type-0.1.0.1/lift-type.cabal 
new/lift-type-0.1.1.1/lift-type.cabal
--- old/lift-type-0.1.0.1/lift-type.cabal       2021-04-24 00:38:25.000000000 
+0200
+++ new/lift-type-0.1.1.1/lift-type.cabal       2022-11-24 19:42:10.000000000 
+0100
@@ -1,6 +1,6 @@
 cabal-version: 1.12
 name:           lift-type
-version:        0.1.0.1
+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
@@ -25,7 +25,7 @@
   hs-source-dirs:
       src
   build-depends:
-      base >=4.10 && <5
+      base >= 4.10 && <5
     , template-haskell
   default-language: Haskell2010
 
@@ -36,7 +36,7 @@
       test
   ghc-options: -threaded -rtsopts -with-rtsopts=-N
   build-depends:
-      base >=4.7 && <5
+      base
     , lift-type
     , template-haskell
   default-language: Haskell2010
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' 
'--exclude=.svnignore' old/lift-type-0.1.0.1/src/LiftType.hs 
new/lift-type-0.1.1.1/src/LiftType.hs
--- old/lift-type-0.1.0.1/src/LiftType.hs       2021-04-24 00:36:31.000000000 
+0200
+++ new/lift-type-0.1.1.1/src/LiftType.hs       2022-11-24 19:42:10.000000000 
+0100
@@ -1,4 +1,11 @@
-{-# language TypeInType, ScopedTypeVariables, AllowAmbiguousTypes, 
TypeApplications, PolyKinds, TemplateHaskell #-}
+{-# 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'.
@@ -18,10 +25,12 @@
 -- @since 0.1.0.0
 module LiftType where
 
-import Data.Char
-import Control.Applicative
-import Type.Reflection
+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.
 --
@@ -29,6 +38,74 @@
 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@.
@@ -60,76 +137,4 @@
 -- @since 0.1.0.0
 liftType :: forall t. Typeable t => Type
 liftType =
-    go (typeRep @t)
-  where
-    go :: forall k (a :: k). TypeRep a -> Type
-    go tr =
-        case tr of
-            Con tyCon ->
-                mk tyCon
-            App trA trB ->
-                AppT (go trA) (go trB)
-            Fun trA trB ->
-                ConT ''(->) `AppT` go trA `AppT` go trB
-
-    mk :: TyCon -> Type
-    mk tyCon =
-        let
-            tcName =
-                tyConName tyCon
-        in
-            if hasTick tcName
-            then
-                let
-                    nameBase =
-                        mkOccName (drop 1 tcName)
-                    flavor =
-                        NameG
-                            DataName
-                            (mkPkgName $ tyConPackage tyCon)
-                            (mkModName $ tyConModule tyCon)
-                    name =
-                        Name
-                            nameBase
-                            flavor
-                in
-                    PromotedT name
-            else if hasDigit tcName then
-                LitT (NumTyLit (read tcName))
-            else if hasQuote tcName then
-                LitT (StrTyLit (stripQuotes tcName))
-            else
-                let
-                    nameBase =
-                        mkOccName tcName
-                    flavor =
-                        NameG
-                            TcClsName
-                            (mkPkgName $ tyConPackage tyCon)
-                            (mkModName $ tyConModule tyCon)
-                    name =
-                        Name
-                            nameBase
-                            flavor
-                in
-                    ConT name
-
-    stripQuotes xs =
-        case xs of
-            [] ->
-                []
-            ('"' : rest) ->
-                reverse (stripQuotes (reverse rest))
-            _ ->
-                xs
-    hasTick = prefixSatisfying ('\'' ==)
-    hasDigit = prefixSatisfying isDigit
-    hasQuote = prefixSatisfying ('"' ==)
-    isList = ("'[]" ==)
-    prefixSatisfying :: (Char -> Bool) -> [Char] -> Bool
-    prefixSatisfying p xs =
-        case xs of
-            a : _ ->
-                p a
-            _ ->
-                False
+    typeRepToType (SomeTypeRep (typeRep @t))
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' 
'--exclude=.svnignore' old/lift-type-0.1.0.1/test/Spec.hs 
new/lift-type-0.1.1.1/test/Spec.hs
--- old/lift-type-0.1.0.1/test/Spec.hs  2021-04-21 22:55:15.000000000 +0200
+++ new/lift-type-0.1.1.1/test/Spec.hs  2022-11-24 19:42:10.000000000 +0100
@@ -1,12 +1,18 @@
-{-# language TemplateHaskell, DataKinds, TypeApplications #-}
+{-# 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)

Reply via email to