{-# LANGUAGE TypeFamilies #-}
--------------------------------------------------------------------
-- |
-- Copyright :  © Eric Mertens 2010-2014
-- License   :  BSD3
-- Maintainer:  Edward Kmett <ekmett@gmail.com>
-- Stability :  experimental
-- Portability: non-portable
--
--------------------------------------------------------------------
module Ersatz.BitChar where

import Data.Char (chr,ord)
import Control.Monad (replicateM)
import Prelude hiding ((&&))

import Ersatz.Bit
import Ersatz.Bits
import Ersatz.Codec
import Ersatz.Equatable
import Ersatz.Orderable
import Ersatz.Variable

-- | List of 'BitChar' intended to be used as the representation for 'String'.
type BitString = [BitChar]

-- | Encoding of the full range of 'Char' values.
newtype BitChar = BitChar Bits
  deriving Int -> BitChar -> ShowS
[BitChar] -> ShowS
BitChar -> String
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

instance Codec BitChar where
  type Decoded BitChar = Char
  encode :: Decoded BitChar -> BitChar
encode                = Bits -> BitChar
BitChar forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord
  decode :: forall (f :: * -> *).
MonadPlus f =>
Solution -> BitChar -> f (Decoded BitChar)
decode Solution
s (BitChar Bits
xs) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Char
chr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral) (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 forall t. Equatable t => t -> t -> Bit
=== Bits
ys
  BitChar Bits
xs /== :: BitChar -> BitChar -> Bit
/== BitChar Bits
ys = Bits
xs forall t. Equatable t => t -> t -> Bit
/== Bits
ys

instance Orderable BitChar where
  BitChar Bits
xs <? :: BitChar -> BitChar -> Bit
<?  BitChar Bits
ys = Bits
xs forall t. Orderable t => t -> t -> Bit
<?  Bits
ys
  BitChar Bits
xs <=? :: BitChar -> BitChar -> Bit
<=? BitChar Bits
ys = Bits
xs forall t. Orderable t => t -> t -> Bit
<=? Bits
ys

instance Variable BitChar where
  literally :: forall s (m :: * -> *). MonadSAT s m => m Literal -> m BitChar
literally m Literal
m =
       -- Char upperbound is 0x10ffff, so only set
       -- the high bit when the next 4 bits are 0

    do Bit
x  <- forall t s (m :: * -> *).
(Variable t, MonadSAT s m) =>
m Literal -> m t
literally m Literal
m
       [Bit]
xs <- forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
20 (forall t s (m :: * -> *).
(Variable t, MonadSAT s m) =>
m Literal -> m t
literally m Literal
m)

       let x' :: Bit
x' = Bit
x forall b. Boolean b => b -> b -> b
&& forall b (t :: * -> *). (Boolean b, Foldable t) => t b -> b
nor (forall a. Int -> [a] -> [a]
take Int
4 [Bit]
xs)
           n :: Bits
n  = [Bit] -> Bits
Bits (forall a. [a] -> [a]
reverse (Bit
x'forall a. a -> [a] -> [a]
:[Bit]
xs)) -- Bits is little endian

       forall (m :: * -> *) a. Monad m => a -> m a
return (Bits -> BitChar
BitChar Bits
n)