{-# LANGUAGE DeriveDataTypeable #-}
{-# 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 Data.Typeable (Typeable)

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
(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 =
       -- Char upperbound is 0x10ffff, so only set
       -- the high bit when the next 4 bits are 0

    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)) -- Bits is little endian

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