module DDC.Core.Salt.Name.Lit
( readLitInteger
, readLitNat
, readLitInt
, readLitSize
, readLitWordOfBits
, readLitFloatOfBits)
where
import Data.List
import Data.Char
readLitInteger :: String -> Maybe Integer
readLitInteger [] = Nothing
readLitInteger str@(c:cs)
| '-' <- c
, all isDigit cs
= Just $ read str
| all isDigit cs
= Just $ read str
| otherwise
= Nothing
readLitNat :: String -> Maybe Integer
readLitNat str1
| (ds, "") <- span isDigit str1
, not $ null ds
= Just $ read ds
| otherwise
= Nothing
readLitInt :: String -> Maybe Integer
readLitInt str1
| '-' : str2 <- str1
, (ds, "i") <- span isDigit str2
, not $ null ds
= Just $ negate $ read ds
| (ds, "i") <- span isDigit str1
, not $ null ds
= Just $ read ds
| otherwise
= Nothing
readLitSize :: String -> Maybe Integer
readLitSize str1
| '-' : str2 <- str1
, (ds, "s") <- span isDigit str2
, not $ null ds
= Just $ negate $ read ds
| (ds, "s") <- span isDigit str1
, not $ null ds
= Just $ read ds
| otherwise
= Nothing
readLitWordOfBits :: String -> Maybe (Integer, Int)
readLitWordOfBits str1
| Just str2 <- stripPrefix "0b" str1
, (ds, str3) <- span (\c -> c == '0' || c == '1') str2
, not $ null ds
, Just str4 <- stripPrefix "w" str3
, (bs, "") <- span isDigit str4
, not $ null bs
, bits <- read bs
, length ds <= bits
= Just (readBinary ds, bits)
| Just str2 <- stripPrefix "0x" str1
, (ds, str3) <- span (\c -> elem c ['0' .. '9']
|| elem c ['A' .. 'F']
|| elem c ['a' .. 'f']) str2
, not $ null ds
, Just str4 <- stripPrefix "w" str3
, (bs, "") <- span isDigit str4
, not $ null bs
, bits <- read bs
, length ds <= bits
= Just (readHex ds, bits)
| (ds, str2) <- span isDigit str1
, not $ null ds
, Just str3 <- stripPrefix "w" str2
, (bs, "") <- span isDigit str3
, not $ null bs
= Just (read ds, read bs)
| otherwise
= Nothing
readLitFloatOfBits :: String -> Maybe (Double, Int)
readLitFloatOfBits str1
| '-' : str2 <- str1
, Just (d, bs) <- readLitFloatOfBits str2
= Just (negate d, bs)
| (ds1, str2) <- span isDigit str1
, not $ null ds1
, Just str3 <- stripPrefix "." str2
, (ds2, str4) <- span isDigit str3
, not $ null ds2
, Just str5 <- stripPrefix "f" str4
, (bs, "") <- span isDigit str5
, not $ null bs
= Just (read (ds1 ++ "." ++ ds2), read bs)
| otherwise
= Nothing
readBinary :: Num a => String -> a
readBinary digits
= foldl' (\acc b -> if b then 2 * acc + 1 else 2 * acc) 0
$ map (/= '0') digits
readHex :: (Enum a, Num a) => String -> a
readHex digits
= foldl' (\acc d -> let Just v = lookup d table
in 16 * acc + v) 0
$ digits
where table
= zip ['0' .. '9'] [0 .. 9]
++ zip ['a' .. 'f'] [10 .. 15]
++ zip ['A' .. 'F'] [10 .. 15]