module Types.Data.Num.Decimal.Literals.TH where
import Language.Haskell.TH
import qualified Types.Data.Num.Decimal.Digits as D
import qualified Types.Data.Num.Ops as O
decLiteralT :: Integer -> Q Type
decLiteralT k = appT (conT (''D.Dec)) (decLiteralT' k)
where decLiteralT' n | n < 0 = appT (conT ''D.Neg') (decLiteralT' (n))
| n == 0 = conT ''D.DecN
| otherwise = appT (appT (conT ''(O.:.)) (decLiteralT' (n `div` 10))) (conT (case n `mod` 10 of
0 -> ''D.Dec0
1 -> ''D.Dec1
2 -> ''D.Dec2
3 -> ''D.Dec3
4 -> ''D.Dec4
5 -> ''D.Dec5
6 -> ''D.Dec6
7 -> ''D.Dec7
8 -> ''D.Dec8
9 -> ''D.Dec9
d -> error $ "not a decimal digit: " ++ show d))
decLiteralV :: Integer -> Q Exp
decLiteralV n = sigE [| undefined |] (decLiteralT n)
decLiteralD :: String
-> String
-> Integer
-> Q [Dec]
decLiteralD typePrefix valPrefix n =
do let (tsign, vsign, num) =
if n < 0 then ("N", "n", show (n)) else ("", "", show n)
typeName = mkName $ typePrefix ++ tsign ++ num
valName = mkName $ valPrefix ++ vsign ++ num
tySyn <- tySynD typeName [] (decLiteralT n)
sig <- sigD valName (conT typeName)
val <- valD (varP valName) (normalB [| undefined |]) []
return [ tySyn, sig, val ]
decLiteralsD :: String
-> String
-> Integer
-> Integer
-> Q [Dec]
decLiteralsD typePrefix valPrefix from to =
fmap concat $ sequence $ [ decLiteralD typePrefix valPrefix n | n <- [from..to] ]