type-level-show (empty) → 0.1.0
raw patch · 6 files changed
+249/−0 lines, 6 filesdep +basedep +defun-core
Dependencies added: base, defun-core
Files
- CHANGELOG.md +4/−0
- LICENSE +20/−0
- README.md +29/−0
- src/TypeLevelShow/Natural.hs +112/−0
- src/TypeLevelShow/Utils.hs +29/−0
- type-level-show.cabal +55/−0
+ CHANGELOG.md view
@@ -0,0 +1,4 @@+## 0.1.0 (2024-05-07)+Initial release.++* some simple type-level printy helpers
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2024 Ben Orchard (@raehik) <thefirstmuffinman@gmail.com>++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.
+ README.md view
@@ -0,0 +1,29 @@+# type-level-show+Utilities for writing `Show`-like type families i.e. instead of `showsPrec+:: Int -> a -> ShowS`, we have `ShowsPrec :: Natural -> k -> Symbol`.++Requires at least GHC 9.2 for the type-level `Symbol` manipulation.++## Why?+[refined-hackage]: https://hackage.haskell.org/package/refined+[rerefined-hackage]: https://hackage.haskell.org/package/rerefined++[refined][refined-hackage] fills out error messages using `TypeRep`s. My rewrite+[rerefined][rerefined-hackage] allows you to use `Typeable` to fill out a+predicate name, or you can do it yourself. But `TypeRep` is a pain to use, and+it seems strange to do runtime work on type representations. Why can't we just+do it on the type level?++We _could_, but the problem is nice formatting. `Show` instances handle+precedence, and the base library provides a bunch of handy utilities such as+`showParen :: Bool -> ShowS -> ShowS`. Worse, I couldn't find a `ShowNat ::+Natural -> Symbol` type family on Hoogle, which is a very simple type family+that should certainly be lying around.++This library intends to provide such utilities, so that rerefined can avoid+`Typeable` altogether.++Unsure if I'll provide a `ShowType`. Lower priority than the plain utilities.++## License+Provided under the MIT license. See `LICENSE` for license text.
+ src/TypeLevelShow/Natural.hs view
@@ -0,0 +1,112 @@+{-# LANGUAGE UndecidableInstances #-}++module TypeLevelShow.Natural where++import GHC.TypeLits+import DeFun.Core ( type (~>), type App, type (@@) )++type ShowNatBin n = ShowNatBase 2 ShowNatBinaryDigitSym n+type ShowNatOct n = ShowNatBase 8 ShowNatOctalDigitSym n+type ShowNatDec n = ShowNatBase 10 ShowNatDecimalDigitSym n+type ShowNatHexLower n = ShowNatBase 16 ShowNatHexDigitLowerSym n+type ShowNatHexUpper n = ShowNatBase 16 ShowNatHexDigitUpperSym n++-- | Render a type-level 'Natural' in the given base using the given digit+-- printer.+type family ShowNatBase base showDigit n where+ -- | Our algorithm returns the empty 'Symbol' for 0, so handle it here.+ ShowNatBase base showDigit 0 = "0"++ ShowNatBase base showDigit n = ShowNatBase' base showDigit "" n++type ShowNatBase' :: Natural -> (Natural ~> Char) -> Symbol -> Natural -> Symbol+type family ShowNatBase' base showDigit acc n where+ ShowNatBase' base showDigit acc 0 = acc+ ShowNatBase' base showDigit acc n = ShowNatBase' base showDigit+ (ConsSymbol (showDigit @@ (n `Mod` base)) acc) (n `Div` base)++-- TODO add TypeErrors to invalid usages of these digit printers+-- should be free performance-wise so no harm+-- low priority because they're internals anyway++type family ShowNatBinaryDigit (d :: Natural) :: Char where+ ShowNatBinaryDigit 0 = '0'+ ShowNatBinaryDigit 1 = '1'++type ShowNatBinaryDigitSym :: Natural ~> Char+data ShowNatBinaryDigitSym d+type instance App ShowNatBinaryDigitSym d = ShowNatBinaryDigit d++type family ShowNatOctalDigit (d :: Natural) :: Char where+ ShowNatOctalDigit 0 = '0'+ ShowNatOctalDigit 1 = '1'+ ShowNatOctalDigit 2 = '2'+ ShowNatOctalDigit 3 = '3'+ ShowNatOctalDigit 4 = '4'+ ShowNatOctalDigit 5 = '5'+ ShowNatOctalDigit 6 = '6'+ ShowNatOctalDigit 7 = '7'++type ShowNatOctalDigitSym :: Natural ~> Char+data ShowNatOctalDigitSym d+type instance App ShowNatOctalDigitSym d = ShowNatOctalDigit d++type family ShowNatDecimalDigit (d :: Natural) :: Char where+ ShowNatDecimalDigit 0 = '0'+ ShowNatDecimalDigit 1 = '1'+ ShowNatDecimalDigit 2 = '2'+ ShowNatDecimalDigit 3 = '3'+ ShowNatDecimalDigit 4 = '4'+ ShowNatDecimalDigit 5 = '5'+ ShowNatDecimalDigit 6 = '6'+ ShowNatDecimalDigit 7 = '7'+ ShowNatDecimalDigit 8 = '8'+ ShowNatDecimalDigit 9 = '9'++type ShowNatDecimalDigitSym :: Natural ~> Char+data ShowNatDecimalDigitSym d+type instance App ShowNatDecimalDigitSym d = ShowNatDecimalDigit d++type family ShowNatHexDigitLower (d :: Natural) :: Char where+ ShowNatHexDigitLower 0 = '0'+ ShowNatHexDigitLower 1 = '1'+ ShowNatHexDigitLower 2 = '2'+ ShowNatHexDigitLower 3 = '3'+ ShowNatHexDigitLower 4 = '4'+ ShowNatHexDigitLower 5 = '5'+ ShowNatHexDigitLower 6 = '6'+ ShowNatHexDigitLower 7 = '7'+ ShowNatHexDigitLower 8 = '8'+ ShowNatHexDigitLower 9 = '9'+ ShowNatHexDigitLower 10 = 'a'+ ShowNatHexDigitLower 11 = 'b'+ ShowNatHexDigitLower 12 = 'c'+ ShowNatHexDigitLower 13 = 'd'+ ShowNatHexDigitLower 14 = 'e'+ ShowNatHexDigitLower 15 = 'f'++type ShowNatHexDigitLowerSym :: Natural ~> Char+data ShowNatHexDigitLowerSym d+type instance App ShowNatHexDigitLowerSym d = ShowNatHexDigitLower d++type family ShowNatHexDigitUpper (d :: Natural) :: Char where+ ShowNatHexDigitUpper 0 = '0'+ ShowNatHexDigitUpper 1 = '1'+ ShowNatHexDigitUpper 2 = '2'+ ShowNatHexDigitUpper 3 = '3'+ ShowNatHexDigitUpper 4 = '4'+ ShowNatHexDigitUpper 5 = '5'+ ShowNatHexDigitUpper 6 = '6'+ ShowNatHexDigitUpper 7 = '7'+ ShowNatHexDigitUpper 8 = '8'+ ShowNatHexDigitUpper 9 = '9'+ ShowNatHexDigitUpper 10 = 'A'+ ShowNatHexDigitUpper 11 = 'B'+ ShowNatHexDigitUpper 12 = 'C'+ ShowNatHexDigitUpper 13 = 'D'+ ShowNatHexDigitUpper 14 = 'E'+ ShowNatHexDigitUpper 15 = 'F'++type ShowNatHexDigitUpperSym :: Natural ~> Char+data ShowNatHexDigitUpperSym d+type instance App ShowNatHexDigitUpperSym d = ShowNatHexDigitUpper d
+ src/TypeLevelShow/Utils.hs view
@@ -0,0 +1,29 @@+{-# LANGUAGE UndecidableInstances #-}++module TypeLevelShow.Utils where++import GHC.TypeLits++-- | Surround the given 'Symbol' with parentheses when the 'Bool' parameter is+-- 'True'.+type ShowParen :: Bool -> Symbol -> Symbol+type family ShowParen b p where+ ShowParen False p = p+ ShowParen True p = ConsSymbol '(' p `AppendSymbol` ")"++-- | Surround the given 'Symbol' with parentheses if the given precedence is+-- greater than the given 'Natural'.+--+-- Type-level relational operations are a pain. This may be easier to use.+type ShowParenIfGt :: Natural -> Natural -> Symbol -> Symbol+type ShowParenIfGt n d p = ShowParen (OrderingGT (CmpNat d n)) p++type family OrderingGT (a :: Ordering) :: Bool where+ OrderingGT LT = False+ OrderingGT EQ = False+ OrderingGT GT = True++type ShowChar ch = ConsSymbol ch ""++type l ++ r = AppendSymbol l r+type l > r = OrderingGT (CmpNat l r)
+ type-level-show.cabal view
@@ -0,0 +1,55 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.35.2.+--+-- see: https://github.com/sol/hpack++name: type-level-show+version: 0.1.0+synopsis: Utilities for writing Show-like type families+description: Please see README.md.+category: Types, Data+homepage: https://github.com/raehik/type-level-show#readme+bug-reports: https://github.com/raehik/type-level-show/issues+author: Ben Orchard+maintainer: Ben Orchard <thefirstmuffinman@gmail.com>+license: MIT+license-file: LICENSE+build-type: Simple+tested-with:+ GHC==9.8+ , GHC==9.6+ , GHC==9.4+ , GHC==9.2+extra-source-files:+ README.md+ CHANGELOG.md++source-repository head+ type: git+ location: https://github.com/raehik/type-level-show++library+ exposed-modules:+ TypeLevelShow.Natural+ TypeLevelShow.Utils+ other-modules:+ Paths_type_level_show+ hs-source-dirs:+ src+ default-extensions:+ LambdaCase+ NoStarIsType+ DerivingVia+ DeriveAnyClass+ GADTs+ RoleAnnotations+ DefaultSignatures+ TypeFamilies+ DataKinds+ MagicHash+ ghc-options: -Wall -Wno-unticked-promoted-constructors+ build-depends:+ base >=4.16 && <5+ , defun-core ==0.1.*+ default-language: GHC2021