{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE TypeFamilies #-}
module Ersatz.BitChar where
import Data.Char (chr,ord)
import Control.Monad (replicateM)
import Prelude hiding ((&&))
import Data.Typeable (Typeable)
import Ersatz.Bit
import Ersatz.Bits
import Ersatz.Codec
import Ersatz.Equatable
import Ersatz.Orderable
import Ersatz.Variable
type BitString = [BitChar]
newtype BitChar = BitChar Bits
deriving (Int -> BitChar -> ShowS
[BitChar] -> ShowS
BitChar -> String
(Int -> BitChar -> ShowS)
-> (BitChar -> String) -> ([BitChar] -> ShowS) -> Show BitChar
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BitChar] -> ShowS
$cshowList :: [BitChar] -> ShowS
show :: BitChar -> String
$cshow :: BitChar -> String
showsPrec :: Int -> BitChar -> ShowS
$cshowsPrec :: Int -> BitChar -> ShowS
Show,Typeable)
instance Codec BitChar where
type Decoded BitChar = Char
encode :: Decoded BitChar -> BitChar
encode = Bits -> BitChar
BitChar (Bits -> BitChar) -> (Char -> Bits) -> Char -> BitChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Bits
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Bits) -> (Char -> Int) -> Char -> Bits
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord
decode :: Solution -> BitChar -> f (Decoded BitChar)
decode Solution
s (BitChar Bits
xs) = (Integer -> Char) -> f Integer -> f Char
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Char
chr (Int -> Char) -> (Integer -> Int) -> Integer -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) (Solution -> Bits -> f (Decoded Bits)
forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s Bits
xs)
instance Equatable BitChar where
BitChar Bits
xs === :: BitChar -> BitChar -> Bit
=== BitChar Bits
ys = Bits
xs Bits -> Bits -> Bit
forall t. Equatable t => t -> t -> Bit
=== Bits
ys
BitChar Bits
xs /== :: BitChar -> BitChar -> Bit
/== BitChar Bits
ys = Bits
xs Bits -> Bits -> Bit
forall t. Equatable t => t -> t -> Bit
/== Bits
ys
instance Orderable BitChar where
BitChar Bits
xs <? :: BitChar -> BitChar -> Bit
<? BitChar Bits
ys = Bits
xs Bits -> Bits -> Bit
forall t. Orderable t => t -> t -> Bit
<? Bits
ys
BitChar Bits
xs <=? :: BitChar -> BitChar -> Bit
<=? BitChar Bits
ys = Bits
xs Bits -> Bits -> Bit
forall t. Orderable t => t -> t -> Bit
<=? Bits
ys
instance Variable BitChar where
literally :: m Literal -> m BitChar
literally m Literal
m =
do Bit
x <- m Literal -> m Bit
forall t s (m :: * -> *).
(Variable t, MonadSAT s m) =>
m Literal -> m t
literally m Literal
m
[Bit]
xs <- Int -> m Bit -> m [Bit]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
20 (m Literal -> m Bit
forall t s (m :: * -> *).
(Variable t, MonadSAT s m) =>
m Literal -> m t
literally m Literal
m)
let x' :: Bit
x' = Bit
x Bit -> Bit -> Bit
forall b. Boolean b => b -> b -> b
&& [Bit] -> Bit
forall b (t :: * -> *). (Boolean b, Foldable t) => t b -> b
nor (Int -> [Bit] -> [Bit]
forall a. Int -> [a] -> [a]
take Int
4 [Bit]
xs)
n :: Bits
n = [Bit] -> Bits
Bits ([Bit] -> [Bit]
forall a. [a] -> [a]
reverse (Bit
x'Bit -> [Bit] -> [Bit]
forall a. a -> [a] -> [a]
:[Bit]
xs))
BitChar -> m BitChar
forall (m :: * -> *) a. Monad m => a -> m a
return (Bits -> BitChar
BitChar Bits
n)