AddBytes.hs

{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module AddBytes where

import           Control.Monad.Trans.State

data Bit = O | I
  deriving (Show, Eq, Ord)

type Carry = Bit

add :: Bit -> Bit -> Bit -> (Bit, Carry)
add O O O = (O, O)
add O O I = (I, O)
add O I O = (I, O)
add O I I = (O, I)
add I O O = (I, O)
add I O I = (O, I)
add I I O = (O, I)
add I I I = (I, I)

newtype BitAdder a = BitAdder (State Carry a)
  deriving (Functor, Applicative, Monad)

runAdder :: BitAdder a -> (a, Carry)
runAdder = runAdder' O

runAdder' :: Bit -> BitAdder a -> (a, Carry)
runAdder' c (BitAdder s) = runState s c

class BitAdd a where
  bitAdd :: a -> a -> BitAdder a

instance BitAdd Bit where
  bitAdd a b = BitAdder $ state $ add a b

data Byte = Byte Bit Bit Bit Bit Bit Bit Bit Bit
  deriving (Show, Eq)

instance BitAdd Byte where
  bitAdd (Byte a1 a2 a3 a4 a5 a6 a7 a8) (Byte b1 b2 b3 b4 b5 b6 b7 b8)
    = Byte
    <$> bitAdd a1 b1
    <*> bitAdd a2 b2
    <*> bitAdd a3 b3
    <*> bitAdd a4 b4
    <*> bitAdd a5 b5
    <*> bitAdd a6 b6
    <*> bitAdd a7 b7
    <*> bitAdd a8 b8

data MWord = MWord Byte Byte
  deriving (Show, Eq)

instance BitAdd MWord where
  bitAdd (MWord a1 a2) (MWord b1 b2)
    = MWord <$> bitAdd a1 a2 <*> bitAdd b1 b2