---------------------------------------------------------------------------
-- |
-- Module      :  Data.Numbers.CrackNum.Utils
-- Copyright   :  (c) Levent Erkok
-- License     :  BSD3
-- Maintainer  :  erkokl@gmail.com
-- Stability   :  experimental
--
-- Various utils and sundry
-----------------------------------------------------------------------------

module Data.Numbers.CrackNum.Utils where

import Data.Char     (toLower)
import Data.List     (genericIndex)
import Numeric

import Data.Numbers.CrackNum.Data (Precision(..), IPrecision(..))

-- | Returns True if all bits are False
all0 :: [Bool] -> Bool
all0 :: [Bool] -> Bool
all0 = (Bool -> Bool) -> [Bool] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Bool -> Bool
not

-- | Returns True if all bits are True
all1 :: [Bool] -> Bool
all1 :: [Bool] -> Bool
all1 = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and

-- | Returns True if any bit is True
any1 :: [Bool] -> Bool
any1 :: [Bool] -> Bool
any1 = (Bool
True Bool -> [Bool] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`)

-- | Lay out a sequence of separated bools as a nicely formatted binary number
layOut :: [[Bool]] -> String
layOut :: [[Bool]] -> String
layOut = [String] -> String
unwords ([String] -> String)
-> ([[Bool]] -> [String]) -> [[Bool]] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Bool] -> String) -> [[Bool]] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map [Bool] -> String
b2s

-- | Binary to String conversion
b2s :: [Bool] -> String
b2s :: [Bool] -> String
b2s bs :: [Bool]
bs = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [if Bool
b then "1" else "0" | Bool
b <- [Bool]
bs]

-- | Test whether a digit is binary
isBinDigit :: Char -> Bool
isBinDigit :: Char -> Bool
isBinDigit = (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` "01")

-- | Convert from binary char digit to value
binDigit :: Char -> Int
binDigit :: Char -> Int
binDigit '0' = 0
binDigit '1' = 1
binDigit c :: Char
c   = String -> Int
forall a. HasCallStack => String -> a
error (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ "binDigit: recevied: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char -> String
forall a. Show a => a -> String
show Char
c

-- | Read a number in base 16
readB16 :: String -> Integer
readB16 :: String -> Integer
readB16 s :: String
s = case ReadS Integer
forall a. (Eq a, Num a) => ReadS a
readHex String
s of
              [(v :: Integer
v, "")] -> Integer
v
              _         -> String -> Integer
forall a. HasCallStack => String -> a
error (String -> Integer) -> String -> Integer
forall a b. (a -> b) -> a -> b
$ "Invalid hex input: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
s

-- | Read a number in base 2
readB2 :: String -> Integer
readB2 :: String -> Integer
readB2 s :: String
s = case Integer -> (Char -> Bool) -> (Char -> Int) -> ReadS Integer
forall a. Num a => a -> (Char -> Bool) -> (Char -> Int) -> ReadS a
readInt 2 Char -> Bool
isBinDigit Char -> Int
binDigit String
s of
              [(v :: Integer
v, "")] -> Integer
v
              _         -> String -> Integer
forall a. HasCallStack => String -> a
error (String -> Integer) -> String -> Integer
forall a b. (a -> b) -> a -> b
$ "Invalid binary input: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
s

-- | Display a binary number in groups of 4
binDisp :: [Bool] -> String
binDisp :: [Bool] -> String
binDisp = String -> String
grpBy4 (String -> String) -> ([Bool] -> String) -> [Bool] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Bool] -> String
b2s

-- | Group in chunks of 44
grpBy4 :: String -> String
grpBy4 :: String -> String
grpBy4 = Bool -> String -> String
grp Bool
False
  where grp :: Bool -> String -> String
grp _   [] = []
        grp sep :: Bool
sep xs :: String
xs = let (f :: String
f, r :: String
r) = Int -> String -> (String, String)
forall a. Int -> [a] -> ([a], [a])
splitAt 4 String
xs in (if Bool
sep then " " else "") String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
f String -> String -> String
forall a. [a] -> [a] -> [a]
++ Bool -> String -> String
grp Bool
True String
r

-- | Display a binary number in groups of 4, in hexadecimal format
hexDisp :: [Bool] -> String
hexDisp :: [Bool] -> String
hexDisp = String -> String
grpBy4 (String -> String) -> ([Bool] -> String) -> [Bool] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Bool] -> String
chunkHex
  where chunkHex :: [Bool] -> String
chunkHex [] = []
        chunkHex xs :: [Bool]
xs = let (f :: [Bool]
f, r :: [Bool]
r) = Int -> [Bool] -> ([Bool], [Bool])
forall a. Int -> [a] -> ([a], [a])
splitAt 4 [Bool]
xs in (String
letters String -> Int -> Char
forall i a. Integral i => [a] -> i -> a
`genericIndex` ([Bool] -> Int
forall a. Num a => [Bool] -> a
bv [Bool]
f :: Int)) Char -> String -> String
forall a. a -> [a] -> [a]
: [Bool] -> String
chunkHex [Bool]
r
        letters :: String
letters = ['0' .. '9'] String -> String -> String
forall a. [a] -> [a] -> [a]
++ ['A' .. 'F']

-- | Cluster a list into given size chunks
cluster :: Int -> [a] -> [[a]]
cluster :: Int -> [a] -> [[a]]
cluster n :: Int
n is :: [a]
is = [a] -> [[a]]
forall a. [a] -> [[a]]
go [a]
is
  where s :: Int
s = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
is Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
n
        go :: [a] -> [[a]]
go [] = []
        go xs :: [a]
xs = let (f :: [a]
f, r :: [a]
r) = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
s [a]
xs in [a]
f [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [a] -> [[a]]
go [a]
r

-- | Big-endian num converter
bv :: Num a => [Bool] -> a
bv :: [Bool] -> a
bv = (Bool -> a -> a) -> a -> [Bool] -> a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\b :: Bool
b a :: a
a -> 2 a -> a -> a
forall a. Num a => a -> a -> a
* a
a a -> a -> a
forall a. Num a => a -> a -> a
+ Bool -> a
forall p. Num p => Bool -> p
b2i Bool
b) 0 ([Bool] -> a) -> ([Bool] -> [Bool]) -> [Bool] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Bool] -> [Bool]
forall a. [a] -> [a]
reverse
 where b2i :: Bool -> p
b2i b :: Bool
b = if Bool
b then 1 else 0

-- | Drop unnecessary parts from input. This enables the user to be able to give data more easily
cleanUp :: String -> String
cleanUp :: String -> String
cleanUp = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
ignorable)
  where ignorable :: Char -> Bool
ignorable = (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` " _-")

----------------------------------------------------------------------------------------------------
-- Rulers
----------------------------------------------------------------------------------------------------

-- | Half-precision ruler, line 1
hpInds1 :: String
-- | Half-precision ruler, line 2
hpInds2 :: String
-- | Half-precision ruler, line 3
hpInds3 :: String

hpInds1 :: String
hpInds1 = "1       0"
hpInds2 :: String
hpInds2 = "5 43210 9876543210"
hpInds3 :: String
hpInds3 = "S -E5-- ---F10----"

-- | Single-precision ruler, line 1
spInds1 :: String
-- | Single-precision ruler, line 2
spInds2 :: String
-- | Single-precision ruler, line 3
spInds3 :: String

spInds1 :: String
spInds1 = "3  2          1         0"
spInds2 :: String
spInds2 = "1 09876543 21098765432109876543210"
spInds3 :: String
spInds3 = "S ---E8--- ----------F23----------"

-- | Double-precision ruler, line 1
dpInds1 :: String
-- | Double-precision ruler, line 2
dpInds2 :: String
-- | Double-precision ruler, line 3
dpInds3 :: String

dpInds1 :: String
dpInds1 = "6    5          4         3         2         1         0"
dpInds2 :: String
dpInds2 = "3 21098765432 1098765432109876543210987654321098765432109876543210"
dpInds3 :: String
dpInds3 = "S ----E11---- ------------------------F52-------------------------"

-- | Byte-precision ruler, line 2 (note that no line 1 is needed!)
bInds2 :: String
bInds2 :: String
bInds2 = "7654 3210"

-- | Word-precision ruler, line 1
wInds1 :: String
-- | Word-precision ruler, line 2
wInds2 :: String

wInds1 :: String
wInds1 = "1      0"
wInds2 :: String
wInds2 = "5432 1098 7654 3210"

-- | Double-word-precision ruler, line 1
dInds1 :: String
-- | Double-word-precision ruler, line 2
dInds2 :: String

dInds1 :: String
dInds1 = "3 2            1           0"
dInds2 :: String
dInds2 = "1098 7654 3210 9876 5432 1098 7654 3210"

-- | Quad-word-precision ruler, line 1
qInds1 :: String
-- | QuadDouble-word-precision ruler, line 2
qInds2 :: String

qInds1 :: String
qInds1 = "6    5           4            3           2            1           0"
qInds2 :: String
qInds2 = "3210 9876 5432 1098 7654 3210 9876 5432 1098 7654 3210 9876 5432 1098 7654 3210"

-- | Convert Floating point precision to corresponding number of bits
fpSz :: Precision -> Int
fpSz :: Precision -> Int
fpSz HP = 16
fpSz SP = 32
fpSz DP = 64

-- | Convert Integer precision to whether it's signed and how many bits
sgSz :: IPrecision -> (Bool, Int)
sgSz :: IPrecision -> (Bool, Int)
sgSz W8  = (Bool
False,  8)
sgSz I8  = (Bool
True,   8)
sgSz W16 = (Bool
False, 16)
sgSz I16 = (Bool
True,  16)
sgSz W32 = (Bool
False, 32)
sgSz I32 = (Bool
True,  32)
sgSz W64 = (Bool
False, 64)
sgSz I64 = (Bool
True,  64)