{-# LANGUAGE BangPatterns, FlexibleInstances, FunctionalDependencies, Safe #-}

{-|
Module      : Dep.Data.LogicItem
Description : A module that defines data structures for a sums, products, sum-of-products and product-of-sums.
Maintainer  : hapytexeu+gh@gmail.com
Stability   : experimental
Portability : POSIX

This module provides utility functions to compress/decompress sums, products, sum-of-products and product-of-sums.
-}

module Dep.Data.LogicItem (
  -- * Evaluating logical items
    EvaluateItem(evaluateItem, evaluateWithBits, isTrivial, numberOfVariables)
  -- * Convert from and to a compact format
  , ToCompact(toCompact, fromCompact)
  -- * Binary encode/decode 'ThreeValues' in an efficient way.
  , getThreeList, putThreeList
    -- * Typesetting variables
  , subscriptVariable, subscriptNegatedVariable, subscriptConditionVariable
    -- * Alias for 'ThreeValues'
  , Item'
  ) where

import Data.Bits(Bits, (.|.), (.&.), shiftL, shiftR, testBit)
import Data.Binary(Get, Put, getWord8, putWord8)
import Data.Char.Small(asSub')
import Data.Text(Text, cons, snoc)
import Data.Word(Word8)

import Dep.Data.ThreeValue(ThreeValue(Zero, One, DontCare), ThreeValues)

-- | An alias for 'ThreeValues': an item ('Dep.Data.Product.Product' or 'Dep.Data.Sum.Sum') is a sequence of 'ThreeValue's.
type Item' = ThreeValues

-- | A typeclass for objects that can be evaluated to a 'Bool'
-- based on multiple variables. Numbering of the bits starts by
-- __one__ because a 'Dep.Data.Sum.CompactSum' and 'Dep.Data.Product.CompactProduct'
-- start indexes by one, due to the fact that @0@ and @-0@ are equal.
class EvaluateItem a where
  -- | Evaluate the given item with a function that derives the value
  -- for the given /i/-th 'Bool'.
  evaluateItem
    :: (Int -> Bool)  -- ^ A function to determine the value of the /i/-th 'Bool'.
    -> a  -- ^ The given binary function to evaluate.
    -> Bool  -- ^ The result after evaluating the object.

  -- | Determine the outcome of the given 'EvaluateItem' based on the values
  -- specified in a 'Bits' object where the /i/-th 'Bool' is the /i-1/-th bit
  -- of the data.
  evaluateWithBits :: Bits b
    => b  -- ^ The given 'Bits' object that holds the values for the 'Bool's.
    -> a  -- ^ The given binary function to evaluate.
    -> Bool  -- ^ The result after evluating the given object.
  evaluateWithBits b
d = (Int -> Bool) -> a -> Bool
forall a. EvaluateItem a => (Int -> Bool) -> a -> Bool
evaluateItem Int -> Bool
go
    where go :: Int -> Bool
go = (b -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
0) (b -> Bool) -> (Int -> b) -> Int -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Int -> b
forall a. Bits a => a -> Int -> a
shiftR b
d (Int -> b) -> (Int -> Int) -> Int -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
forall a. Enum a => a -> a
pred

  -- | Check if the given object is trivially 'True' ('One'); 'False' ('Zero'),
  -- or a non-trivial function ('DontCare').
  isTrivial
    :: a  -- ^ The given logical item to test.
    -> ThreeValue  -- ^ returns 'One' if the 'EvaluateItem' object always resolves to 'True'; 'Zero' if the object always resolves to 'False'; and 'DontCare' if the function is not trivial.

  -- | Determine the largest index of the variables for which the 'EvaluateItem' is sensitive for.
  numberOfVariables
    :: a  -- ^ The given 'EvaluateItem'.
    -> Int  -- ^ The largest index of the variables the given 'EvaluateItem' is sensitive for.
  {-# MINIMAL evaluateItem, isTrivial, numberOfVariables #-}

-- | A class that specifies that a given logic item can be made more compact, or from a compact form to
-- its original form. The two functions are not per se fully each others inverse.
class ToCompact a b | a -> b where
  -- | Convert the given item to a more compact representation.
  toCompact
    :: a  -- ^ The given item to turn in a compact form.
    -> b  -- ^ The corresponding compact form.

  -- | Convert the given item from a compact representation to its normal presentation.
  fromCompact
    :: b  -- ^ The given compact form that should be represented to the normal form.
    -> a  -- ^ The corresponding normal form.
  {-# MINIMAL toCompact, fromCompact #-}

instance ToCompact [ThreeValue] [Int] where
  toCompact :: [ThreeValue] -> [Int]
toCompact = Int -> [ThreeValue] -> [Int]
forall a. Num a => a -> [ThreeValue] -> [a]
go Int
1
    where go :: a -> [ThreeValue] -> [a]
go a
_ [] = []
          go !a
i (ThreeValue
DontCare:[ThreeValue]
xs) = a -> [ThreeValue] -> [a]
go (a
ia -> a -> a
forall a. Num a => a -> a -> a
+a
1) [ThreeValue]
xs
          go a
i (ThreeValue
One:[ThreeValue]
xs) = a
i a -> [a] -> [a]
forall a. a -> [a] -> [a]
: a -> [ThreeValue] -> [a]
go (a
ia -> a -> a
forall a. Num a => a -> a -> a
+a
1) [ThreeValue]
xs
          go a
i (~ThreeValue
Zero:[ThreeValue]
xs) = -a
i a -> [a] -> [a]
forall a. a -> [a] -> [a]
: a -> [ThreeValue] -> [a]
go (a
ia -> a -> a
forall a. Num a => a -> a -> a
+a
1) [ThreeValue]
xs
  fromCompact :: [Int] -> [ThreeValue]
fromCompact = Int -> [Int] -> [ThreeValue]
forall a. (Num a, Ord a) => a -> [a] -> [ThreeValue]
go Int
1
    where go :: a -> [a] -> [ThreeValue]
go a
_ [] = []
          go !a
i xa :: [a]
xa@(a
x:[a]
xs)
            | a -> a
forall a. Num a => a -> a
abs a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
i = ThreeValue
DontCare ThreeValue -> [ThreeValue] -> [ThreeValue]
forall a. a -> [a] -> [a]
: a -> [a] -> [ThreeValue]
go (a
ia -> a -> a
forall a. Num a => a -> a -> a
+a
1) [a]
xa
            | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0 = ThreeValue
Zero ThreeValue -> [ThreeValue] -> [ThreeValue]
forall a. a -> [a] -> [a]
: a -> [a] -> [ThreeValue]
go (a
ia -> a -> a
forall a. Num a => a -> a -> a
+a
1) [a]
xs
            | Bool
otherwise = ThreeValue
One ThreeValue -> [ThreeValue] -> [ThreeValue]
forall a. a -> [a] -> [a]
: a -> [a] -> [ThreeValue]
go (a
ia -> a -> a
forall a. Num a => a -> a -> a
+a
1) [a]
xs

-- | Convert the given list of 'ThreeValue's to a writer for a binary stream that
-- encodes four 'ThreeValue's on one byte.
putThreeList :: ThreeValues -> Put
putThreeList :: [ThreeValue] -> Put
putThreeList = [ThreeValue] -> Put
forall a. Enum a => [a] -> Put
go
  where go :: [a] -> Put
go [] = Word8 -> Put
putWord8 Word8
0xff
        go ~(a
x:[a]
xs) = Word8 -> [a] -> Put
go' (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a -> Int
forall a. Enum a => a -> Int
fromEnum a
x)) [a]
xs
        go' :: Word8 -> [a] -> Put
go' Word8
n [] = Word8 -> Put
putWord8 (Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
shiftL Word8
n Int
6 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
0x3f)
        go' Word8
n ~(a
x:[a]
xs) = Word8 -> [a] -> Put
go'' (Word8 -> a -> Word8
forall a a. (Bits a, Num a, Enum a) => a -> a -> a
mv Word8
n a
x) [a]
xs
        go'' :: Word8 -> [a] -> Put
go'' Word8
n [] = Word8 -> Put
putWord8 (Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
shiftL Word8
n Int
4 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
0xf)
        go'' Word8
n ~(a
x:[a]
xs) = Word8 -> [a] -> Put
go''' (Word8 -> a -> Word8
forall a a. (Bits a, Num a, Enum a) => a -> a -> a
mv Word8
n a
x) [a]
xs
        go''' :: Word8 -> [a] -> Put
go''' Word8
n [] = Word8 -> Put
putWord8 (Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
shiftL Word8
n Int
2 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
0x3)
        go''' Word8
n ~(a
x:[a]
xs) = Word8 -> Put
putWord8 (Word8 -> a -> Word8
forall a a. (Bits a, Num a, Enum a) => a -> a -> a
mv Word8
n a
x) Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [a] -> Put
go [a]
xs
        mv :: a -> a -> a
mv a
n a
x = a -> Int -> a
forall a. Bits a => a -> Int -> a
shiftL a
n Int
2 a -> a -> a
forall a. Bits a => a -> a -> a
.|. Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a -> Int
forall a. Enum a => a -> Int
fromEnum a
x)

-- | Read a list o 'ThreeValue's from a binary stream where each byte represents
-- (up to) four 'ThreeValue's.
getThreeList :: Get ThreeValues
getThreeList :: Get [ThreeValue]
getThreeList = Get Word8
getWord8 Get Word8 -> (Word8 -> Get [ThreeValue]) -> Get [ThreeValue]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word8 -> Get [ThreeValue]
go
  where go :: Word8 -> Get ThreeValues
        go :: Word8 -> Get [ThreeValue]
go Word8
255 = [ThreeValue] -> Get [ThreeValue]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
        go Word8
n | Word8 -> Int -> Word8
forall a. (Bits a, Num a) => a -> Int -> a
shr Word8
n Int
0 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
3 = Word8 -> [ThreeValue] -> [ThreeValue]
forall a a. (Integral a, Bits a, Enum a) => a -> [a] -> [a]
prcs Word8
n ([ThreeValue] -> [ThreeValue])
-> Get [ThreeValue] -> Get [ThreeValue]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Get Word8
getWord8 Get Word8 -> (Word8 -> Get [ThreeValue]) -> Get [ThreeValue]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word8 -> Get [ThreeValue]
go)
             | Bool
otherwise = [ThreeValue] -> Get [ThreeValue]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word8 -> [ThreeValue] -> [ThreeValue]
forall a a. (Integral a, Bits a, Enum a) => a -> [a] -> [a]
prcs Word8
n [])
        prcs :: a -> [a] -> [a]
prcs a
n = a -> Int -> [a] -> [a]
forall a a. (Integral a, Bits a, Enum a) => a -> Int -> [a] -> [a]
tk a
n Int
6 ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Int -> [a] -> [a]
forall a a. (Integral a, Bits a, Enum a) => a -> Int -> [a] -> [a]
tk a
n Int
4 ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Int -> [a] -> [a]
forall a a. (Integral a, Bits a, Enum a) => a -> Int -> [a] -> [a]
tk a
n Int
2 ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Int -> [a] -> [a]
forall a a. (Integral a, Bits a, Enum a) => a -> Int -> [a] -> [a]
tk a
n Int
0
        shr :: a -> Int -> a
shr a
n Int
k = a
0x03 a -> a -> a
forall a. Bits a => a -> a -> a
.&. a -> Int -> a
forall a. Bits a => a -> Int -> a
shiftR a
n Int
k
        tk :: a -> Int -> [a] -> [a]
tk a
n Int
k = a -> [a] -> [a]
forall a a. (Integral a, Enum a) => a -> [a] -> [a]
prc (a -> Int -> a
forall a. (Bits a, Num a) => a -> Int -> a
shr a
n Int
k)
        prc :: a -> [a] -> [a]
prc a
n | a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
3 = (Int -> a
forall a. Enum a => Int -> a
toEnum (a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n) a -> [a] -> [a]
forall a. a -> [a] -> [a]
:)
              | Bool
otherwise = [a] -> [a]
forall a. a -> a
id

-- | Convert the given number to a 'Text' object containing the "root" variable
-- name and the index as subscript.
subscriptVariable
  :: Char  -- ^ The "root" variable that we will use with a subscript.
  -> Int  -- ^ The subscript that will be added to the character.
  -> Text -- ^ A text object that contains the "root" variable with the subscript.
subscriptVariable :: Char -> Int -> Text
subscriptVariable Char
ci = Char -> Text -> Text
cons Char
ci (Text -> Text) -> (Int -> Text) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text
forall i. Integral i => i -> Text
asSub'

-- | Convert the given number to a 'Text' object containing the "root" variable
-- name and the index as subscript.
subscriptNegatedVariable
  :: Char  -- ^ The "root" variable that we will use with a subscript.
  -> Int  -- ^ The subscript that will be added to the character.
  -> Text -- ^ A text object that contains the "root" variable with the subscript and an accent to mark its negation.
subscriptNegatedVariable :: Char -> Int -> Text
subscriptNegatedVariable Char
ci = (Text -> Char -> Text
`snoc` Char
'\'') (Text -> Text) -> (Int -> Text) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text -> Text
cons Char
ci (Text -> Text) -> (Int -> Text) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text
forall i. Integral i => i -> Text
asSub'

-- | Convert the given number to a 'Text' objet that contains the "root" variable,
-- name, the index, and based on a given 'Bool' can include a quote mark if the
-- variable should be 'False'.
subscriptConditionVariable
  :: Char  -- ^ The "root" variable that will be used with a subscript.
  -> Int  -- ^ The subscript that will be added to the variable.
  -> Bool  -- ^ A 'Bool' that is 'False' if the item should be negated; and 'True' otherwise.
  -> Text  -- ^ A 'Text' object that contains the root variable, the subscript, and an accent if necessary.
subscriptConditionVariable :: Char -> Int -> Bool -> Text
subscriptConditionVariable Char
c Int
i = Bool -> Text
go
  where go :: Bool -> Text
go Bool
True = Char -> Int -> Text
subscriptVariable Char
c Int
i
        go ~Bool
False = Char -> Int -> Text
subscriptNegatedVariable Char
c Int
i