{-# LANGUAGE FlexibleContexts #-}
module Text.IntFormats (IntFormat(..), parseInt, intParser, showInt) where
import Text.Parsec hiding (digit)
import Text.Parsec.Char (alphaNum)
import Data.Char (toUpper)
import Data.List (foldl1')
import Test.QuickCheck (Arbitrary, arbitrary, oneof)
data IntFormat =
Decimal |
Hexadecimal |
Octal |
Binary |
HexUpper deriving (Show, Eq)
intParser :: (Integral a, Stream s m Char) => ParsecT s u m a
intParser = do
negative <- option ' ' (char '-')
value <- (char '0' >> parseBase) <|> parseDec
notFollowedBy (alphaNum <|> char '.')
if negative == '-' then return (-value) else return value
parseInt :: Integral a => String -> Either String a
parseInt = mapLeft show . parse intParser ""
parseBase :: (Integral a, Stream s m Char) => ParsecT s u m a
parseBase = (char 'x' >> parseHex) <|> (char 'o' >> parseOct) <|> (char 'b' >> parseBin) <|> (char 'd' >> parseDec) <|>
(char 'X' >> parseHex) <|> (char 'O' >> parseOct) <|> (char 'B' >> parseBin) <|> (char 'D' >> parseDec) <|> parseDec <|> return 0
showInt :: Integral a
=> Bool
-> IntFormat
-> a
-> String
showInt prefix base n = if n < 0 then '-' : showInt' base (-n) else showInt' base n
where showInt' Decimal = (if prefix then ("0d"++) else id) . digits 10
showInt' Hexadecimal = (if prefix then ("0x"++) else id) . digits 16
showInt' HexUpper = (if prefix then ("0x"++) else id) . map toUpper . digits 16
showInt' Octal = (if prefix then ("0o"++) else id) . digits 8
showInt' Binary = (if prefix then ("0b"++) else id) . digits 2
undigits :: Integral a => a -> String -> a
undigits n = foldl1' (\a b -> a*n+b) . map undigit
digits :: Integral a => a -> a -> String
digits n x = if x `div` n == 0 then [digit x] else digits n (x `div` n) ++ [digit (x `mod` n)]
parseDec :: (Integral a, Stream s m Char) => ParsecT s u m a
parseDec = undigits 10 <$> many1 (oneOf "1234567890") <?> "one or more decimal digits"
parseHex :: (Integral a, Stream s m Char) => ParsecT s u m a
parseHex = undigits 16 <$> many1 (oneOf "1234567890abcdefABCDEF") <?> "one or more dexadecimal digits"
parseOct :: (Integral a, Stream s m Char) => ParsecT s u m a
parseOct = undigits 8 <$> many1 (oneOf "12345670") <?> "one or more octal digits"
parseBin :: (Integral a, Stream s m Char) => ParsecT s u m a
parseBin = undigits 2 <$> many1 (oneOf "01") <?> "one or more binary undigits"
undigit :: Integral a => Char -> a
undigit '0' = 0
undigit '1' = 1
undigit '2' = 2
undigit '3' = 3
undigit '4' = 4
undigit '5' = 5
undigit '6' = 6
undigit '7' = 7
undigit '8' = 8
undigit '9' = 9
undigit 'a' = 10
undigit 'b' = 11
undigit 'c' = 12
undigit 'd' = 13
undigit 'e' = 14
undigit 'f' = 15
undigit 'A' = 10
undigit 'B' = 11
undigit 'C' = 12
undigit 'D' = 13
undigit 'E' = 14
undigit 'F' = 15
undigit _ = undefined
digit :: Integral a => a -> Char
digit 0 = '0'
digit 1 = '1'
digit 2 = '2'
digit 3 = '3'
digit 4 = '4'
digit 5 = '5'
digit 6 = '6'
digit 7 = '7'
digit 8 = '8'
digit 9 = '9'
digit 10 = 'a'
digit 11 = 'b'
digit 12 = 'c'
digit 13 = 'd'
digit 14 = 'e'
digit 15 = 'f'
digit _ = undefined
instance Arbitrary IntFormat where
arbitrary = oneof $ map return [Hexadecimal, HexUpper, Decimal, Octal, Binary]
mapLeft :: (a -> b) -> Either a c -> Either b c
mapLeft f (Left x) = Left $ f x
mapLeft _ (Right x) = Right x