module Type.Digits
(digitStrings, radix,
Digit,
digit, toType, toType_, toDigits, toDigits_,
flexible, fixed, flexible', fixed',
exactly,
digitNames, digitTypes, digitStopName, digitStopType) where
import Type.Spine
import Type.Spine.TH (liftNameG_d)
import Type.Digits.Stage0
import Type.Digits.Stage1
import Type.Digits.Aux
import Language.Haskell.TH
fmap concat $ mapM spineType_pro $ 'DigitStop : digitNames
digit :: (Show a, Eq a, Num a) => a -> Name
digit r = $(caseE [| r |] $ [
match (litP (IntegerL k))
(normalB $ liftNameG_d $ mkName n) []
| (k, n) <- zip [0..] digitStrings]
++ [match wildP (normalB $ [| error $ "Type.Digits.digit: not (0 <= " ++ show r ++ " < " ++ show radix ++ ")" |]) []])
toType :: [Name] -> Type -> Type
toType = foldr (\n acc -> AppT (PromotedT n) . acc) id
toType_ :: [Name] -> Type
toType_ = ($ PromotedT 'DigitStop) . toType
toDigits :: (a -> [Name]) -> a -> Type -> Type
toDigits f = toType . f
toDigits_ :: (a -> [Name]) -> a -> Type
toDigits_ = (($ PromotedT 'DigitStop) .) . toDigits
flexible' :: Enum a => a -> [Name]
flexible' = flexible . fromEnum
fixed' :: Enum a => a -> [Name]
fixed' = fixed . fromEnum
flexible :: (Show a, Eq a, 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, Show a, Eq a, Integral a) => a -> [Name]
fixed = exactly (ceiling $ width (Proxy :: Proxy a)) . flexible
width :: (Bounded a, Integral a, Floating b) => Proxy a -> b
width = width' . spanT
width' :: Floating a => Integer -> a
width' = logBase radix . fromInteger
spanT :: forall a. (Bounded a, Integral a) => Proxy a -> Integer
spanT _ = 1 + toInteger (maxBound :: a) toInteger (minBound :: a)
spanT' :: forall a. (Bounded a, Enum a) => Proxy 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