-----------------------------------------------------------------------------
-- |
-- Module      :  Data.SBV.BitVectors.PrettyNum
-- Copyright   :  (c) Levent Erkok
-- License     :  BSD3
-- Maintainer  :  erkokl@gmail.com
-- Stability   :  experimental
-- Portability :  portable
--
-- Number representations in hex/bin
-----------------------------------------------------------------------------

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE PatternGuards #-}

module Data.SBV.BitVectors.PrettyNum (PrettyNum(..), readBin) where

import Data.Char  (ord)
import Data.Int   (Int8, Int16, Int32, Int64)
import Data.List  (isPrefixOf)
import Data.Maybe (fromJust)
import Data.Word  (Word8, Word16, Word32, Word64)
import Numeric    (showIntAtBase, showHex, readInt)

import Data.SBV.BitVectors.Bit
import Data.SBV.BitVectors.Data
import Data.SBV.BitVectors.Model () -- instances only

-- | PrettyNum class captures printing of numbers in hex and binary formats; also supporting negative numbers.
--
-- Minimal complete definition: 'hexS' and 'binS'
class PrettyNum a where
  -- | Show a number in hexadecimal (starting with @0x@)
  hexS :: a -> String
  -- | Show a number in binary (starting with @0b@)
  binS :: a -> String
  -- | IO version of 'hexS'
  hex :: a -> IO ()
  hex = putStrLn . hexS
  -- | IO version of 'binS'
  bin   :: a -> IO ()
  bin = putStrLn . binS

-- Why not default methods? Because defaults need "Integral a" and Bool/Bit are not..
instance PrettyNum Bool   where {hexS = show; binS = show}
instance PrettyNum Bit    where {hexS = show; binS = show}
instance PrettyNum Word8  where {hexS = shex; binS = sbin}
instance PrettyNum Int8   where {hexS = shex; binS = sbin}
instance PrettyNum Word16 where {hexS = shex; binS = sbin}
instance PrettyNum Int16  where {hexS = shex; binS = sbin}
instance PrettyNum Word32 where {hexS = shex; binS = sbin}
instance PrettyNum Int32  where {hexS = shex; binS = sbin}
instance PrettyNum Word64 where {hexS = shex; binS = sbin}
instance PrettyNum Int64  where {hexS = shex; binS = sbin}

instance PrettyNum CW where
  hexS (W1  i) = hexS $ bit2Bool i
  hexS (W8  i) = hexS i
  hexS (W16 i) = hexS i
  hexS (W32 i) = hexS i
  hexS (W64 i) = hexS i
  hexS (I8  i) = hexS i
  hexS (I16 i) = hexS i
  hexS (I32 i) = hexS i
  hexS (I64 i) = hexS i
  binS (W1  i) = binS $ bit2Bool i
  binS (W8  i) = binS i
  binS (W16 i) = binS i
  binS (W32 i) = binS i
  binS (W64 i) = binS i
  binS (I8  i) = binS i
  binS (I16 i) = binS i
  binS (I32 i) = binS i
  binS (I64 i) = binS i

instance (SymWord a, PrettyNum a) => PrettyNum (SBV a) where
  hexS s = maybe (show s) (hexS :: a -> String) $ unliteral s
  binS s = maybe (show s) (binS :: a -> String) $ unliteral s

shex :: (HasSignAndSize a, Integral a) => a -> String
shex a
 | a < 0
 = "-0x" ++ pad l (s16 (abs ((fromIntegral a) :: Integer)))  ++ t
 | True
 =  "0x" ++ pad l (s16 a) ++ t
 where t = " :: " ++ (if hasSign a then "Int" else "Word") ++ show (l*4)
       l = sizeOf a `div` 4

sbin :: (HasSignAndSize a, Integral a) => a -> String
sbin a
 | a < 0
 = "-0b" ++ pad l (s2 (abs ((fromIntegral a) :: Integer)))  ++ t
 | True
 =  "0b" ++ pad l (s2 a) ++ t
 where t = " :: " ++ (if hasSign a then "Int" else "Word") ++ show l
       l = sizeOf a

pad :: Int -> String -> String
pad l s = replicate (l - length s) '0' ++ s

s2, s16 :: Integral a => a -> String
s2  v = showIntAtBase 2 dig v "" where dig = fromJust . flip lookup [(0, '0'), (1, '1')]
s16 v = showHex v ""

-- | A more convenient interface for reading binary numbers, also supports negative numbers
readBin :: Num a => String -> a
readBin ('-':s) = -(readBin s)
readBin s = case readInt 2 isDigit cvt s' of
              [(a, "")] -> a
              _         -> error $ "SBV.readBin: Cannot read a binary number from: " ++ show s
  where cvt c = ord c - ord '0'
        isDigit = (`elem` "01")
        s' | "0b" `isPrefixOf` s = drop 2 s
           | True                = s