type-reflection (empty) → 1.0

raw patch · 6 files changed

+362/−0 lines, 6 filesdep +basedep +hashabledep +sop-core

Dependencies added: base, hashable, sop-core, tasty, tasty-hunit, text, type-reflection

Files

• CHANGELOG.md +5/−0
• LICENSE +20/−0
• src/Type/Reflection/List.hs +42/−0
• src/Type/Reflection/Name.hs +184/−0
• test/Test.hs +59/−0
• type-reflection.cabal +52/−0

@@ -0,0 +1,5 @@+# Revision history for type-reflection++## 1.0++* Initial release.

@@ -0,0 +1,20 @@+Copyright (c) 2022 Richard Eisenberg++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

@@ -0,0 +1,42 @@+{-# LANGUAGE DataKinds, GADTs #-}++{-|+Description : Utilities for manipulating runtime representations of compile-time lists+Copyright   : Richard Eisenberg+License     : MIT+Maintainer  : rae@richarde.dev+Stability   : experimental++Provides utilities for manipulating a 'TypeRep' of compile-time lists.++-}++module Type.Reflection.List (+  typeRepList, typeRepListKind,+  ) where++import Type.Reflection+import Data.SOP.NP++-- | Given a representation of a list, get a representation of the kind of the list's+-- elements.+typeRepListKind :: TypeRep @[k] xs -> TypeRep k+typeRepListKind tr+  | App _list tr_k <- typeRepKind tr+  = tr_k++-- | Turn a representation of a list into a list of representations.+typeRepList :: forall {k} (xs :: [k]). TypeRep xs -> NP TypeRep xs+typeRepList tr_list+  | App (App cons tr) trs <- tr_list+  , Just HRefl <- eqTypeRep cons (withTypeable tr_k $ typeRep @((:) @k))+  = tr :* typeRepList trs++  | Just HRefl <- eqTypeRep tr_list (withTypeable tr_k $ typeRep @('[] @k))+  = Nil++  | otherwise+  = error "list is neither (:) nor []."++  where+    tr_k = typeRepListKind tr_list

@@ -0,0 +1,184 @@+{-# LANGUAGE OverloadedStrings #-}++{-|+Description : Utilities for controlling how to serialize type representations into strings+Copyright   : Richard Eisenberg+License     : MIT+Maintainer  : rae@richarde.dev+Stability   : experimental++This module provides three different ways of serializing a 'TypeRep' into a 'Text':+qualifying no names, qualifying all names, or package-qualifying all names. In order+to support meaningful notions of equality on these string representations (for e.g.+using them as keys in a map), @newtype@s are provided for each format.++-}++module Type.Reflection.Name (+  -- * Unqualified names+  Unqualified(..), getUnqualified, showUnqualified,++  -- * Qualified names+  Qualified(..), getQualified, showQualified,++  -- * Package-qualified names+  PackageQualified(..), getPackageQualified, showPackageQualified,++  -- * Class-based access+  TypeText(..), defaultRenderTypeRep,++  ) where++import Data.String ( IsString(..) )+import Data.Hashable ( Hashable )+import Data.Text ( Text )++import Type.Reflection++------------------------------------------------------+-- TypeText, a class that describes how TyCons are rendered++-- | The 'TypeText' class describes how a 'TyCon' is rendered+-- into a textual representation, and it is used to render a 'TypeRep'+-- by 'renderTypeRep'. The 'IsString' superclass is needed to insert+-- connectives like spaces, dots, and parentheses, and the 'Monoid'+-- superclass is needed to stitch these pieces together.+--+-- Only 'renderTyCon' is needed for instances; if 'renderTypeRep' is+-- omitted, then the default rendering, via 'defaultRenderTypeRep' is+-- used. See that function for more details.+--+-- The only consistency law for 'TypeText' is this, holding for all+-- @tr@ of type 'TypeRep' :+--+-- > case tr of Con' tc [] -> renderTypeRep tr == renderTyCon tc+-- >            _ -> True+--+-- In other words, rendering a 'TypeRep' consisting only of a 'TyCon'+-- is the same as rendering the 'TyCon' itself. If the 'TypeRep' is not+-- a plain 'TyCon' (with no kind arguments), then there are no applicable+-- laws. Note that the law uses '==', even though 'Eq' is not a superclass+-- of 'TypeText'.+class (IsString tt, Monoid tt, Ord tt) => TypeText tt where+  renderTyCon :: TyCon -> tt++  renderTypeRep :: TypeRep t -> tt+  renderTypeRep = defaultRenderTypeRep++  {-# MINIMAL renderTyCon #-}++------------------------------------------------------+-- Unqualified++-- | A rendering of a type where no components have module or package qualifications.+-- Data constructors used in types are preceded with a @'@, and infix operator types+-- are printed without parentheses. Uses 'defaultRenderTypeRep' to render types; see+-- that function for further details.+newtype Unqualified = MkUnqualified Text+  deriving (Eq, Ord, Show, Hashable, Semigroup, Monoid, IsString)++instance TypeText Unqualified where+  renderTyCon = fromString . tyConName++-- | Extract the contents of an 'Unqualified' rendering+getUnqualified :: Unqualified -> Text+getUnqualified (MkUnqualified str) = str++-- | Convert a 'TypeRep' into an 'Unqualified' representation+showUnqualified :: TypeRep t -> Unqualified+showUnqualified = renderTypeRep++----------------------------------------------------------+-- Qualified++-- | A rendering of a type where all components have module qualifications.+-- Data constructors used in types are preceded first with their module qualification,+-- and then with a @'@, and infix operator types+-- are printed without parentheses. So we have @Data.Proxy.'Proxy@ for the v'Proxy' constructor.+-- Uses 'defaultRenderTypeRep' to render types; see+-- that function for further details.j+--+-- Note that module qualifications arise from the module that defines a type, even if this+-- is a hidden or internal module. This fact means that internal-structure changes in+-- your libraries may affect how your types are rendered, including changes in e.g. @base@.+newtype Qualified = MkQualified Text+  deriving (Eq, Ord, Show, Hashable, Semigroup, Monoid, IsString)++instance TypeText Qualified where+  renderTyCon tc = fromString (tyConModule tc) <> "." <> fromString (tyConName tc)++-- | Extract the contents of a 'Qualified' rendering+getQualified :: Qualified -> Text+getQualified (MkQualified str) = str++-- | Convert a 'TypeRep' into a 'Qualified' representation+showQualified :: TypeRep t -> Qualified+showQualified = renderTypeRep++------------------------------------------------------------+-- PackageQualified++-- | A rendering of a type where all components have package and module qualifications+-- Data constructors used in types are preceded first with their package qualification,+-- and then their module qualification,+-- and then with a @'@, and infix operator types+-- are printed without parentheses. So we have @base.Data.Proxy.'Proxy@ for the v'Proxy' constructor.+-- Uses 'defaultRenderTypeRep' to render types; see+-- that function for further details.+--+-- Note that module qualifications arise from the module that defines a type, even if this+-- is a hidden or internal module. This fact means that internal-structure changes in+-- your libraries may affect how your types are rendered, including changes in e.g. @base@.+newtype PackageQualified = MkPackageQualified Text+  deriving (Eq, Ord, Show, Hashable, Semigroup, Monoid, IsString)++instance TypeText PackageQualified where+ renderTyCon tc = fromString (tyConPackage tc) <> "." <>+                  fromString (tyConModule tc) <> "." <>+                  fromString (tyConName tc)++-- | Extract the contents of a 'PackageQualified' name+getPackageQualified :: PackageQualified -> Text+getPackageQualified (MkPackageQualified str) = str++-- | Convert a 'TypeRep' into a 'PackageQualified' representation+showPackageQualified :: TypeRep t -> PackageQualified+showPackageQualified = renderTypeRep++----------------------------------------------+-- Worker++-- | Render a 'TypeRep' into an instance of 'TypeText'. This follows the following+-- rules for how to render a type:+--+-- * Function types are rendered infix. If a function takes another function as an+-- argument, the argument function is rendered in parentheses (as required by the+-- right-associative @->@ operator).+--+-- * All other type constructors are rendered prefix, including the list constructor @[]@+-- and the tuple constructors e.g. @(,,)@, along with any other type operators.+--+-- * All kind arguments to type constructors are rendered, with \@ prefixes. Any+-- non-atomic (that is, not simply a type constructor with no kind arguments) kinds+-- are enclosed in parentheses.+--+-- * Non-atomic arguments are enclosed in parentheses.+--+-- * Type synonyms are always expanded. This means that we get @[] Char@, not @String@,+-- and we get @TYPE ('BoxedRep 'Lifted)@, not @Type@.+defaultRenderTypeRep ::+  forall tn outer_t.+  TypeText tn =>+  TypeRep outer_t -> tn+defaultRenderTypeRep = go+  where+    go :: TypeRep t -> tn+    go (Fun arg@(Fun {}) res) = "(" <> go arg <> ") -> " <> go res+    go (Fun arg res) = go arg <> " -> " <> go res+    go (App t1 t2@(Con' _ [])) = go t1 <> " " <> go t2+    go (App t1 t2) = go t1 <> " (" <> go t2 <> ")"+    go (Con' tc kinds) = renderTyCon tc <> foldMap go_kind kinds++    go_kind :: SomeTypeRep -> tn+    go_kind (SomeTypeRep kind_rep@(Con' _ [])) = " @" <> go kind_rep+    go_kind (SomeTypeRep kind_rep) = " @(" <> go kind_rep <> ")"

@@ -0,0 +1,59 @@+{-# LANGUAGE OverloadedStrings, DataKinds, MagicHash #-}++module Main where++import Type.Reflection.Name+import Type.Reflection.List++import Test.Tasty+import Test.Tasty.HUnit++import Type.Reflection+import Control.Exception+import Control.Monad ( void )++import Data.Proxy+import GHC.Exts++data a + b++main :: IO ()+main = defaultMain all_tests++all_tests :: TestTree+all_tests = testGroup "All"+  [ testGroup "unqualified"+    [ testCase "Int" $ showUnqualified (typeRep @Int) @?= "Int"+    , testCase "Maybe Bool" $ showUnqualified (typeRep @(Maybe Bool)) @?= "Maybe Bool"+    , testCase "[Double]" $ showUnqualified (typeRep @[Double]) @?= "[] Double"+    , testCase "Proxy 5" $ showUnqualified (typeRep @(Proxy 5)) @?= "Proxy @Natural 5"+    , testCase "'Proxy @5" $ showUnqualified (typeRep @('Proxy @5)) @?= "'Proxy @Natural @5"+    , testCase "(Int, Bool, Double)" $ showUnqualified (typeRep @(Int, Bool, Double)) @?= "(,,) Int Bool Double"+    , testCase "Char + ()" $ showUnqualified (typeRep @(Char + ())) @?= "+ @(TYPE ('BoxedRep 'Lifted)) @(TYPE ('BoxedRep 'Lifted)) Char ()"+    , testCase "Int -> Bool" $ showUnqualified (typeRep @(Int -> Bool)) @?= "Int -> Bool"+    , testCase "(Char -> Double) -> Int# -> Word#" $ showUnqualified (typeRep @((Char -> Double) -> Int# -> Word#)) @?= "(Char -> Double) -> Int# -> Word#"+    , testCase "Either (Maybe Bool) Double" $ showUnqualified (typeRep @(Either (Maybe Bool) Double)) @?= "Either (Maybe Bool) Double"+    ]+  , testGroup "qualified"+    [ testCase "Int" $ showQualified (typeRep @Int) @?= "GHC.Types.Int"+    , testCase "Maybe Bool" $ showQualified (typeRep @(Maybe Bool)) @?= "GHC.Maybe.Maybe GHC.Types.Bool"+    , testCase "[Double]" $ showQualified (typeRep @[Double]) @?= "GHC.Types.[] GHC.Types.Double"+    , testCase "Proxy 5" $ showQualified (typeRep @(Proxy 5)) @?= "Data.Proxy.Proxy @GHC.Num.Natural.Natural GHC.TypeLits.5"+    , testCase "'Proxy @5" $ showQualified (typeRep @('Proxy @5)) @?= "Data.Proxy.'Proxy @GHC.Num.Natural.Natural @GHC.TypeLits.5"+    , testCase "(Int, Bool, Double)" $ showQualified (typeRep @(Int, Bool, Double)) @?= "GHC.Tuple.(,,) GHC.Types.Int GHC.Types.Bool GHC.Types.Double"+    ]+  , testGroup "package qualified"+    [ testCase "Int" $ showPackageQualified (typeRep @Int) @?= "ghc-prim.GHC.Types.Int"+    , testCase "Maybe Bool" $ showPackageQualified (typeRep @(Maybe Bool)) @?= "base.GHC.Maybe.Maybe ghc-prim.GHC.Types.Bool"+    , testCase "[Double]" $ showPackageQualified (typeRep @[Double]) @?= "ghc-prim.GHC.Types.[] ghc-prim.GHC.Types.Double"+    , testCase "Proxy 5" $ showPackageQualified (typeRep @(Proxy 5)) @?= "base.Data.Proxy.Proxy @ghc-bignum.GHC.Num.Natural.Natural base.GHC.TypeLits.5"+    , testCase "'Proxy @5" $ showPackageQualified (typeRep @('Proxy @5)) @?= "base.Data.Proxy.'Proxy @ghc-bignum.GHC.Num.Natural.Natural @base.GHC.TypeLits.5"+    , testCase "(Int, Bool, Double)" $ showPackageQualified (typeRep @(Int, Bool, Double)) @?= "ghc-prim.GHC.Tuple.(,,) ghc-prim.GHC.Types.Int ghc-prim.GHC.Types.Bool ghc-prim.GHC.Types.Double"+    ]+    -- these functions can go wrong only by throwing exceptions, due to their precise types+    -- actually, these should use Control.DeepSeq.force, but neither TypeRep nor P.List support NFData.+    -- I've filed https://github.com/GaloisInc/parameterized-utils/issues/136 and+    -- https://github.com/haskell/deepseq/issues/82+  , testCase "typeRepListKind" $ void $ evaluate (typeRepListKind (typeRep @[Int, Bool, Double]))+  , testCase "typeRepList" $ void $ evaluate (typeRepList (typeRep @[Int, Bool, Double]))+  ]

@@ -0,0 +1,52 @@+cabal-version:      2.4+name:               type-reflection+version:            1.0+synopsis: Support functions to work with type representations.++description:+    Support functions to work with type representations, as exported+    from "Type.Reflection". Of particular interest is a facility+    to translate 'TypeRep's into strings, with customizability around+    whether the rendered strings are fully qualified.++homepage: https://github.com/goldfirere/type-reflection++bug-reports:        https://github.com/goldfirere/type-reflection/issues+license:            MIT+license-file:       LICENSE+author:             Richard Eisenberg+maintainer:         rae@richarde.dev++copyright: Richard Eisenberg+-- category:+extra-source-files: CHANGELOG.md++library+    exposed-modules: Type.Reflection.Name+                     Type.Reflection.List++    other-modules:+    -- other-extensions:+    build-depends:    base >= 4.16 && < 5,+                      sop-core >= 0.5,+                      hashable >= 1.3,+                      text >= 1.2,+    hs-source-dirs:   src+    default-language: GHC2021++    default-extensions:++test-suite test+    default-language: GHC2021+    ghc-options: -Wno-missing-home-modules++    type:             exitcode-stdio-1.0+    hs-source-dirs:   test++    main-is:          Test.hs+    other-modules:++    build-depends:    base >= 4.16 && < 5,+                      type-reflection,+                      tasty >= 1.4.2,+                      tasty-hunit >= 0.10,