{-# LANGUAGE Haskell2010
    , TemplateHaskell
    , TypeOperators
 #-}

module Data.Name.Internal.TH (
    name, nameT, names, (:&), toName
) where


import Numeric (showHex)
import Data.Char (isAlpha, isAlphaNum, isAscii, isUpper, toUpper)
import Language.Haskell.TH


data a :& b

infixr 3 :&


nameT :: String -> Q Type
nameT str = return $ foldr f (conT $ last names) (init names)
    where names = map toName str
          conT n = ConT $ mkName ("Data.Name." ++ n)
          f x xs = AppT (AppT (ConT ''(:&)) (conT x)) xs

name :: String -> Q Exp
name str = nameT str >>= return . SigE (VarE 'undefined)

toName c
  | c `elem` ['0'..'9'] = 'D' : [c]
  | isAscii c = if isUpper c then c : "_" else [toUpper c]
  | True = 'U' : padLeft (map toUpper (showHex (fromEnum c) ""))
    where padLeft str = replicate (4 - length str) '0' ++ str

names chars = do
    let alpha    = filter isAlpha chars
        alphaNum = filter isAlphaNum chars
        dataD = \n -> DataD [] (mkName n) [] [] []

    return [ dataD $ toName c | c <- alphaNum ]