-- | Reading literal values.
module DDC.Core.Salt.Name.Lit
        ( readLitInteger
        , readLitNat
        , readLitInt
        , readLitSize
        , readLitWordOfBits
        , readLitFloatOfBits)

where
import Data.List
import Data.Char


-- | Read a signed integer.
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
        

-- | Read an integer with an explicit format specifier like @1234i@.
readLitNat :: String -> Maybe Integer
readLitNat str1
        | (ds, "")      <- span isDigit str1
        , not  $ null ds
        = Just $ read ds

        | otherwise
        = Nothing


-- | Read an integer literal with an explicit format specifier like @1234i@.
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


-- | Read an size literal with an explicit format specifier like @1234s@.
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


-- | Read a word with an explicit format speficier.
readLitWordOfBits :: String -> Maybe (Integer, Int)
readLitWordOfBits str1
        -- binary like 0b01001w32
        | 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)

        -- hex like 0x0ffw32
        | 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)

        -- decimal like 1234w32
        | (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


-- | Read a float literal with an explicit format specifier like @123.00f32#@.
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


-- | Read a binary string as a number.
readBinary :: Num a => String -> a
readBinary digits
        = foldl' (\acc b -> if b then 2 * acc + 1 else 2 * acc) 0
        $ map (/= '0') digits


-- | Read a hex string as a number.
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]