symbols 0.1.0.0 → 0.2.0.0
raw patch · 3 files changed
+135/−15 lines, 3 files
Files
- CHANGELOG.md +5/−1
- src/Data/Symbol/Ascii.hs +125/−10
- symbols.cabal +5/−4
CHANGELOG.md view
@@ -1,5 +1,9 @@ # Revision history for symbols -## 0.1.0.0 -- YYYY-mm-dd+## 0.2.0.0++* added ToList, ToUpper, ToLower, ReadNat type families++## 0.1.0.0 * First version. Released on an unsuspecting world.
src/Data/Symbol/Ascii.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeInType #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE KindSignatures #-}@@ -7,6 +8,10 @@ module Data.Symbol.Ascii ( Head+ , ToList+ , ToUpper+ , ToLower+ , ReadNat ) where import GHC.TypeLits@@ -14,8 +19,13 @@ -- | Compute the first character of a type-level symbol type family Head (sym :: Symbol) :: Symbol where Head "" = ""- Head sym = Lookup sym Chars+ Head sym = Lookup sym "" Chars +-- | Convert the symbol into a list of characters+type family ToList (sym :: Symbol) :: [Symbol] where+ ToList sym = ToList1 sym Chars ""++-------------------------------------------------------------------------------- data Tree a = Leaf | Node (Tree a) a (Tree a)@@ -23,16 +33,121 @@ type LookupTable = Tree (Symbol, Symbol) -type family Lookup (x :: Symbol) (xs :: LookupTable) :: Symbol where- Lookup "" _ = ""- Lookup x (Node l '(cl, cr) r) = Lookup2 (CmpSymbol cl x) (CmpSymbol cr x) x cl l r+type family ToList1 (sym :: Symbol) (table :: LookupTable) (prefix :: Symbol) :: [Symbol] where+ ToList1 sym table sym = '[]+ ToList1 sym table prefix = Lookup sym prefix table ': ToList1 sym table (AppendSymbol prefix (Lookup sym prefix table)) -type family Lookup2 ol or x cl l r :: Symbol where- Lookup2 EQ _ _ cl _ _ = cl- Lookup2 LT GT _ cl _ r = cl- Lookup2 LT _ _ cl _ Leaf = cl -- for the last character (~)- Lookup2 LT _ x _ _ r = Lookup x r- Lookup2 GT _ x _ l _ = Lookup x l+type family Lookup (x :: Symbol) (prefix :: Symbol) (xs :: LookupTable) :: Symbol where+ Lookup "" _ _ = ""+ Lookup x "" (Node l '(cl, cr) r) = Lookup2 (CmpSymbol cl x) (CmpSymbol cr x) x "" cl l r+ Lookup x prefix (Node l '(cl, cr) r) = Lookup2 (CmpSymbol (AppendSymbol prefix cl) x) (CmpSymbol (AppendSymbol prefix cr) x) x prefix cl l r++type family Lookup2 ol or x prefix cl l r :: Symbol where+ Lookup2 EQ _ _ _ cl _ _ = cl+ Lookup2 LT GT _ _ cl _ r = cl+ Lookup2 LT _ _ _ cl _ Leaf = cl -- for the last character (~)+ Lookup2 LT _ x prefix _ _ r = Lookup x prefix r+ Lookup2 GT _ x prefix _ l _ = Lookup x prefix l++--------------------------------------------------------------------------------++-- | Convert the symbol to uppercase+type family ToUpper (sym :: Symbol) :: Symbol where+ ToUpper sym = ToUpper1 (ToList sym)++type family ToUpper1 (sym :: [Symbol]) :: Symbol where+ ToUpper1 '[] = ""+ ToUpper1 (x ': xs) = AppendSymbol (ToUpperC x) (ToUpper1 xs)++type family ToUpperC (sym :: Symbol) :: Symbol where+ ToUpperC "a" = "A"+ ToUpperC "b" = "B"+ ToUpperC "c" = "C"+ ToUpperC "d" = "D"+ ToUpperC "e" = "E"+ ToUpperC "f" = "F"+ ToUpperC "g" = "G"+ ToUpperC "h" = "H"+ ToUpperC "i" = "I"+ ToUpperC "j" = "J"+ ToUpperC "k" = "K"+ ToUpperC "l" = "L"+ ToUpperC "m" = "M"+ ToUpperC "n" = "N"+ ToUpperC "o" = "O"+ ToUpperC "p" = "P"+ ToUpperC "q" = "Q"+ ToUpperC "r" = "R"+ ToUpperC "s" = "S"+ ToUpperC "t" = "T"+ ToUpperC "u" = "U"+ ToUpperC "v" = "V"+ ToUpperC "w" = "W"+ ToUpperC "x" = "X"+ ToUpperC "y" = "Y"+ ToUpperC "z" = "Z"+ ToUpperC a = a+--------------------------------------------------------------------------------++-- | Convert the symbol to lowercase+type family ToLower (sym :: Symbol) :: Symbol where+ ToLower sym = ToLower1 (ToList sym)++type family ToLower1 (sym :: [Symbol]) :: Symbol where+ ToLower1 '[] = ""+ ToLower1 (x ': xs) = AppendSymbol (ToLowerC x) (ToLower1 xs)++type family ToLowerC (sym :: Symbol) :: Symbol where+ ToLowerC "A" = "a"+ ToLowerC "B" = "b"+ ToLowerC "C" = "c"+ ToLowerC "D" = "d"+ ToLowerC "E" = "e"+ ToLowerC "F" = "f"+ ToLowerC "G" = "g"+ ToLowerC "H" = "h"+ ToLowerC "I" = "i"+ ToLowerC "J" = "j"+ ToLowerC "K" = "k"+ ToLowerC "L" = "l"+ ToLowerC "M" = "m"+ ToLowerC "N" = "n"+ ToLowerC "O" = "o"+ ToLowerC "P" = "p"+ ToLowerC "Q" = "q"+ ToLowerC "R" = "r"+ ToLowerC "S" = "s"+ ToLowerC "T" = "t"+ ToLowerC "U" = "u"+ ToLowerC "V" = "v"+ ToLowerC "W" = "w"+ ToLowerC "X" = "x"+ ToLowerC "Y" = "y"+ ToLowerC "Z" = "z"+ ToLowerC a = a++--------------------------------------------------------------------------------+-- | Parse a natural number+type family ReadNat (sym :: Symbol) :: Nat where+ ReadNat sym = ReadNat1 (ToList sym) 0++type family ReadNat1 (sym :: [Symbol]) (n :: Nat) :: Nat where+ ReadNat1 '[] acc = acc+ ReadNat1 (x ': xs) acc = ReadNat1 xs (acc * 10 + ReadDigit x)++type family ReadDigit (sym :: Symbol) :: Nat where+ ReadDigit "0" = 0+ ReadDigit "1" = 1+ ReadDigit "2" = 2+ ReadDigit "3" = 3+ ReadDigit "4" = 4+ ReadDigit "5" = 5+ ReadDigit "6" = 6+ ReadDigit "7" = 7+ ReadDigit "8" = 8+ ReadDigit "9" = 9++-------------------------------------------------------------------------------- -- | The search tree: each node contains two consecutive characters of -- the printable ASCII charset, and we're looking for the node where
symbols.cabal view
@@ -1,8 +1,5 @@--- Initial symbols.cabal generated by cabal init. For further--- documentation, see http://haskell.org/cabal/users-guide/- name: symbols-version: 0.1.0.0+version: 0.2.0.0 synopsis: Symbol manipulation description: Utilities for manipulating type-level strings natively. license: BSD3@@ -15,6 +12,10 @@ extra-source-files: CHANGELOG.md , README.md cabal-version: >=1.10++source-repository head+ type: git+ location: https://github.com/kcsongor/symbols library exposed-modules: Data.Symbol.Ascii