module Type.Digits
(module Type.Digits.Aux,
digit, toType, toType_, toDigits, toDigits_,
flexible, fixed, flexible', fixed',
exactly) where
import Type.Spine
import Type.Spine.Stage0 (kTypeG)
import Type.Spine.TH (liftNameG)
import Data.Proxy.TH (qProxy)
import Type.Digits.Aux
import Language.Haskell.TH
concat `fmap` sequence [ do
n <- return $ mkName n
let k2 = kTypeG $ ArrowK StarK StarK
x <- dataD (return []) n [PlainTV (mkName "x")] [] []
(:[x]) `fmap` tySynInstD ''Spine [k2 `appT` conT n]
(conT ''TypeName `appT` (k2 `appT` conT n))
| n <- digitNames]
digit :: Num a => a -> Name
digit r = $(caseE [| r |] $ [
match (litP (IntegerL k))
(normalB $ liftNameG $ mkName n) []
| (k, n) <- zip [0..] digitNames]
++ [match wildP (normalB $ [| error $ "Type.Digits.digit: not (0 <= " ++ show r ++ " < " ++ show radix ++ ")" |]) []])
toType :: [Name] -> Type -> Type
toType = foldr (\n acc -> AppT (ConT n) . acc) id
toType_ :: [Name] -> Type
toType_ = ($ TupleT 0) . toType
toDigits :: (a -> [Name]) -> a -> Type -> Type
toDigits f = toType . f
toDigits_ :: (a -> [Name]) -> a -> Type
toDigits_ = (($ TupleT 0) .) . toDigits
flexible' :: Enum a => a -> [Name]
flexible' = flexible . fromEnum
fixed' :: Enum a => a -> [Name]
fixed' = fixed . fromEnum
flexible :: Integral a => a -> [Name]
flexible
| 0 == radix = digit'
| otherwise = w where
digit' = (:[]) . digit
w n = k $ digit' r where
(q, r) = quotRem n radix
k | 0 == q = id
| otherwise = (w q ++)
fixed :: forall a. (Bounded a, Integral a) => a -> [Name]
fixed = exactly (ceiling $ width [qProxy|a|]) . flexible
width :: (Bounded a, Integral a, Floating b) => [qProxy|a|] -> b
width = width' . spanT
width' :: Floating a => Integer -> a
width' = logBase radix . fromInteger
spanT :: forall a. (Bounded a, Integral a) => [qProxy|a|] -> Integer
spanT _ = 1 + toInteger (maxBound :: a) toInteger (minBound :: a)
spanT' :: forall a. (Bounded a, Enum a) => [qProxy|a|] -> Integer
spanT' _ = 1 + toInteger (fromEnum (maxBound :: a) fromEnum (minBound :: a))
exactly :: Int -> [Name] -> [Name]
exactly k l
| n > k = error "Base: argument to `exactly' has too many elements"
| otherwise = replicate (k n) (digit 0) ++ l
where n = length l