{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeInType #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE CPP #-}

#if __GLASGOW_HASKELL__ >= 806
{-# LANGUAGE NoStarIsType #-}
#endif

module Data.Symbol.Ascii
  (
    Head
  , ToList
  , ToUpper
  , ToLower
  , ReadNat
  ) where

import GHC.TypeLits
import Data.Symbol.Ascii.Internal (Head, ToList)

--------------------------------------------------------------------------------

-- | 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 sym (ToList sym)

type family ReadNat1 (orig :: Symbol) (sym :: [Symbol]) :: Nat where
  ReadNat1 _ '[] = TypeError ('Text "Parse error: empty string")
  ReadNat1 orig xs  = ReadNat2 orig xs 0

type family ReadNat2 (orgin :: Symbol) (sym :: [Symbol]) (n :: Nat) :: Nat where
  ReadNat2 orig '[] acc = acc
  ReadNat2 orig (x ': xs) acc = ReadNat2 orig xs (10 * acc + ReadDigit orig x)

type family ReadDigit (orig :: Symbol) (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
  ReadDigit orig other =
    TypeError ('Text "Parse error: "
               ':<>: ShowType other
               ':<>: 'Text " is not a valid digit in "
               ':<>: ShowType orig)