{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE DerivingVia #-}
module Data.Profunctor.UniconEncoding(
  Unicon(..), Builder(), build,

  Encoding(..),
  encodeWith, decodeWith,
  idEncoding
) where

import Data.Functor.Classes
import Data.Profunctor (Profunctor(..))
import Data.Profunctor.Cartesian
import Data.Bifunctor (Bifunctor(..))

import Data.Vector (Vector)
import qualified Data.Vector as V
import Control.Monad (guard)

-- | Universal container. Any container type with finite maximum length and
--   finite number of possible shapes can be encoded into @Unicon@.
data Unicon a = MkUnicon !Int !(Vector a)
    deriving stock (Unicon a -> Unicon a -> Bool
(Unicon a -> Unicon a -> Bool)
-> (Unicon a -> Unicon a -> Bool) -> Eq (Unicon a)
forall a. Eq a => Unicon a -> Unicon a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Unicon a -> Unicon a -> Bool
== :: Unicon a -> Unicon a -> Bool
$c/= :: forall a. Eq a => Unicon a -> Unicon a -> Bool
/= :: Unicon a -> Unicon a -> Bool
Eq, Eq (Unicon a)
Eq (Unicon a) =>
(Unicon a -> Unicon a -> Ordering)
-> (Unicon a -> Unicon a -> Bool)
-> (Unicon a -> Unicon a -> Bool)
-> (Unicon a -> Unicon a -> Bool)
-> (Unicon a -> Unicon a -> Bool)
-> (Unicon a -> Unicon a -> Unicon a)
-> (Unicon a -> Unicon a -> Unicon a)
-> Ord (Unicon a)
Unicon a -> Unicon a -> Bool
Unicon a -> Unicon a -> Ordering
Unicon a -> Unicon a -> Unicon a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (Unicon a)
forall a. Ord a => Unicon a -> Unicon a -> Bool
forall a. Ord a => Unicon a -> Unicon a -> Ordering
forall a. Ord a => Unicon a -> Unicon a -> Unicon a
$ccompare :: forall a. Ord a => Unicon a -> Unicon a -> Ordering
compare :: Unicon a -> Unicon a -> Ordering
$c< :: forall a. Ord a => Unicon a -> Unicon a -> Bool
< :: Unicon a -> Unicon a -> Bool
$c<= :: forall a. Ord a => Unicon a -> Unicon a -> Bool
<= :: Unicon a -> Unicon a -> Bool
$c> :: forall a. Ord a => Unicon a -> Unicon a -> Bool
> :: Unicon a -> Unicon a -> Bool
$c>= :: forall a. Ord a => Unicon a -> Unicon a -> Bool
>= :: Unicon a -> Unicon a -> Bool
$cmax :: forall a. Ord a => Unicon a -> Unicon a -> Unicon a
max :: Unicon a -> Unicon a -> Unicon a
$cmin :: forall a. Ord a => Unicon a -> Unicon a -> Unicon a
min :: Unicon a -> Unicon a -> Unicon a
Ord, Int -> Unicon a -> ShowS
[Unicon a] -> ShowS
Unicon a -> String
(Int -> Unicon a -> ShowS)
-> (Unicon a -> String) -> ([Unicon a] -> ShowS) -> Show (Unicon a)
forall a. Show a => Int -> Unicon a -> ShowS
forall a. Show a => [Unicon a] -> ShowS
forall a. Show a => Unicon a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Unicon a -> ShowS
showsPrec :: Int -> Unicon a -> ShowS
$cshow :: forall a. Show a => Unicon a -> String
show :: Unicon a -> String
$cshowList :: forall a. Show a => [Unicon a] -> ShowS
showList :: [Unicon a] -> ShowS
Show, ReadPrec [Unicon a]
ReadPrec (Unicon a)
Int -> ReadS (Unicon a)
ReadS [Unicon a]
(Int -> ReadS (Unicon a))
-> ReadS [Unicon a]
-> ReadPrec (Unicon a)
-> ReadPrec [Unicon a]
-> Read (Unicon a)
forall a. Read a => ReadPrec [Unicon a]
forall a. Read a => ReadPrec (Unicon a)
forall a. Read a => Int -> ReadS (Unicon a)
forall a. Read a => ReadS [Unicon a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall a. Read a => Int -> ReadS (Unicon a)
readsPrec :: Int -> ReadS (Unicon a)
$creadList :: forall a. Read a => ReadS [Unicon a]
readList :: ReadS [Unicon a]
$creadPrec :: forall a. Read a => ReadPrec (Unicon a)
readPrec :: ReadPrec (Unicon a)
$creadListPrec :: forall a. Read a => ReadPrec [Unicon a]
readListPrec :: ReadPrec [Unicon a]
Read, (forall a b. (a -> b) -> Unicon a -> Unicon b)
-> (forall a b. a -> Unicon b -> Unicon a) -> Functor Unicon
forall a b. a -> Unicon b -> Unicon a
forall a b. (a -> b) -> Unicon a -> Unicon b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Unicon a -> Unicon b
fmap :: forall a b. (a -> b) -> Unicon a -> Unicon b
$c<$ :: forall a b. a -> Unicon b -> Unicon a
<$ :: forall a b. a -> Unicon b -> Unicon a
Functor, (forall m. Monoid m => Unicon m -> m)
-> (forall m a. Monoid m => (a -> m) -> Unicon a -> m)
-> (forall m a. Monoid m => (a -> m) -> Unicon a -> m)
-> (forall a b. (a -> b -> b) -> b -> Unicon a -> b)
-> (forall a b. (a -> b -> b) -> b -> Unicon a -> b)
-> (forall b a. (b -> a -> b) -> b -> Unicon a -> b)
-> (forall b a. (b -> a -> b) -> b -> Unicon a -> b)
-> (forall a. (a -> a -> a) -> Unicon a -> a)
-> (forall a. (a -> a -> a) -> Unicon a -> a)
-> (forall a. Unicon a -> [a])
-> (forall a. Unicon a -> Bool)
-> (forall a. Unicon a -> Int)
-> (forall a. Eq a => a -> Unicon a -> Bool)
-> (forall a. Ord a => Unicon a -> a)
-> (forall a. Ord a => Unicon a -> a)
-> (forall a. Num a => Unicon a -> a)
-> (forall a. Num a => Unicon a -> a)
-> Foldable Unicon
forall a. Eq a => a -> Unicon a -> Bool
forall a. Num a => Unicon a -> a
forall a. Ord a => Unicon a -> a
forall m. Monoid m => Unicon m -> m
forall a. Unicon a -> Bool
forall a. Unicon a -> Int
forall a. Unicon a -> [a]
forall a. (a -> a -> a) -> Unicon a -> a
forall m a. Monoid m => (a -> m) -> Unicon a -> m
forall b a. (b -> a -> b) -> b -> Unicon a -> b
forall a b. (a -> b -> b) -> b -> Unicon a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => Unicon m -> m
fold :: forall m. Monoid m => Unicon m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Unicon a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Unicon a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Unicon a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> Unicon a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> Unicon a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Unicon a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Unicon a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Unicon a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Unicon a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Unicon a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Unicon a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Unicon a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> Unicon a -> a
foldr1 :: forall a. (a -> a -> a) -> Unicon a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Unicon a -> a
foldl1 :: forall a. (a -> a -> a) -> Unicon a -> a
$ctoList :: forall a. Unicon a -> [a]
toList :: forall a. Unicon a -> [a]
$cnull :: forall a. Unicon a -> Bool
null :: forall a. Unicon a -> Bool
$clength :: forall a. Unicon a -> Int
length :: forall a. Unicon a -> Int
$celem :: forall a. Eq a => a -> Unicon a -> Bool
elem :: forall a. Eq a => a -> Unicon a -> Bool
$cmaximum :: forall a. Ord a => Unicon a -> a
maximum :: forall a. Ord a => Unicon a -> a
$cminimum :: forall a. Ord a => Unicon a -> a
minimum :: forall a. Ord a => Unicon a -> a
$csum :: forall a. Num a => Unicon a -> a
sum :: forall a. Num a => Unicon a -> a
$cproduct :: forall a. Num a => Unicon a -> a
product :: forall a. Num a => Unicon a -> a
Foldable, Functor Unicon
Foldable Unicon
(Functor Unicon, Foldable Unicon) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> Unicon a -> f (Unicon b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Unicon (f a) -> f (Unicon a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Unicon a -> m (Unicon b))
-> (forall (m :: * -> *) a.
    Monad m =>
    Unicon (m a) -> m (Unicon a))
-> Traversable Unicon
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Unicon (m a) -> m (Unicon a)
forall (f :: * -> *) a.
Applicative f =>
Unicon (f a) -> f (Unicon a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Unicon a -> m (Unicon b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Unicon a -> f (Unicon b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Unicon a -> f (Unicon b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Unicon a -> f (Unicon b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
Unicon (f a) -> f (Unicon a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Unicon (f a) -> f (Unicon a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Unicon a -> m (Unicon b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Unicon a -> m (Unicon b)
$csequence :: forall (m :: * -> *) a. Monad m => Unicon (m a) -> m (Unicon a)
sequence :: forall (m :: * -> *) a. Monad m => Unicon (m a) -> m (Unicon a)
Traversable)

instance Eq1 Unicon where
  liftEq :: forall a b. (a -> b -> Bool) -> Unicon a -> Unicon b -> Bool
liftEq a -> b -> Bool
eq (MkUnicon Int
j Vector a
as) (MkUnicon Int
k Vector b
bs) = Int
j Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
k Bool -> Bool -> Bool
&& (a -> b -> Bool) -> Vector a -> Vector b -> Bool
forall a b. (a -> b -> Bool) -> Vector a -> Vector b -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a -> b -> Bool
eq Vector a
as Vector b
bs

instance Ord1 Unicon where
  liftCompare :: forall a b.
(a -> b -> Ordering) -> Unicon a -> Unicon b -> Ordering
liftCompare a -> b -> Ordering
cmp (MkUnicon Int
j Vector a
as) (MkUnicon Int
k Vector b
bs) = Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
j Int
k Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> (a -> b -> Ordering) -> Vector a -> Vector b -> Ordering
forall a b.
(a -> b -> Ordering) -> Vector a -> Vector b -> Ordering
forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare a -> b -> Ordering
cmp Vector a
as Vector b
bs

-- | A lazy version of 'Unicon'.
--
--   This type is meant to be abstract. Only thing you can do is
--   to convert it into @Unicon@ using 'build'. 
data Builder a = Builder !Int (B a)

build :: Builder a -> Unicon a
build :: forall a. Builder a -> Unicon a
build (Builder Int
n B a
as) = Int -> Vector a -> Unicon a
forall a. Int -> Vector a -> Unicon a
MkUnicon Int
n ([a] -> Vector a
forall a. [a] -> Vector a
V.fromList (B a -> [a]
forall a. B a -> [a]
buildList B a
as))

data B a = Empty | Singleton a | Append (B a) (B a)
  deriving ((forall a b. (a -> b) -> B a -> B b)
-> (forall a b. a -> B b -> B a) -> Functor B
forall a b. a -> B b -> B a
forall a b. (a -> b) -> B a -> B b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> B a -> B b
fmap :: forall a b. (a -> b) -> B a -> B b
$c<$ :: forall a b. a -> B b -> B a
<$ :: forall a b. a -> B b -> B a
Functor, (forall m. Monoid m => B m -> m)
-> (forall m a. Monoid m => (a -> m) -> B a -> m)
-> (forall m a. Monoid m => (a -> m) -> B a -> m)
-> (forall a b. (a -> b -> b) -> b -> B a -> b)
-> (forall a b. (a -> b -> b) -> b -> B a -> b)
-> (forall b a. (b -> a -> b) -> b -> B a -> b)
-> (forall b a. (b -> a -> b) -> b -> B a -> b)
-> (forall a. (a -> a -> a) -> B a -> a)
-> (forall a. (a -> a -> a) -> B a -> a)
-> (forall a. B a -> [a])
-> (forall a. B a -> Bool)
-> (forall a. B a -> Int)
-> (forall a. Eq a => a -> B a -> Bool)
-> (forall a. Ord a => B a -> a)
-> (forall a. Ord a => B a -> a)
-> (forall a. Num a => B a -> a)
-> (forall a. Num a => B a -> a)
-> Foldable B
forall a. Eq a => a -> B a -> Bool
forall a. Num a => B a -> a
forall a. Ord a => B a -> a
forall m. Monoid m => B m -> m
forall a. B a -> Bool
forall a. B a -> Int
forall a. B a -> [a]
forall a. (a -> a -> a) -> B a -> a
forall m a. Monoid m => (a -> m) -> B a -> m
forall b a. (b -> a -> b) -> b -> B a -> b
forall a b. (a -> b -> b) -> b -> B a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => B m -> m
fold :: forall m. Monoid m => B m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> B a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> B a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> B a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> B a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> B a -> b
foldr :: forall a b. (a -> b -> b) -> b -> B a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> B a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> B a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> B a -> b
foldl :: forall b a. (b -> a -> b) -> b -> B a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> B a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> B a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> B a -> a
foldr1 :: forall a. (a -> a -> a) -> B a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> B a -> a
foldl1 :: forall a. (a -> a -> a) -> B a -> a
$ctoList :: forall a. B a -> [a]
toList :: forall a. B a -> [a]
$cnull :: forall a. B a -> Bool
null :: forall a. B a -> Bool
$clength :: forall a. B a -> Int
length :: forall a. B a -> Int
$celem :: forall a. Eq a => a -> B a -> Bool
elem :: forall a. Eq a => a -> B a -> Bool
$cmaximum :: forall a. Ord a => B a -> a
maximum :: forall a. Ord a => B a -> a
$cminimum :: forall a. Ord a => B a -> a
minimum :: forall a. Ord a => B a -> a
$csum :: forall a. Num a => B a -> a
sum :: forall a. Num a => B a -> a
$cproduct :: forall a. Num a => B a -> a
product :: forall a. Num a => B a -> a
Foldable, Functor B
Foldable B
(Functor B, Foldable B) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> B a -> f (B b))
-> (forall (f :: * -> *) a. Applicative f => B (f a) -> f (B a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> B a -> m (B b))
-> (forall (m :: * -> *) a. Monad m => B (m a) -> m (B a))
-> Traversable B
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => B (m a) -> m (B a)
forall (f :: * -> *) a. Applicative f => B (f a) -> f (B a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> B a -> m (B b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> B a -> f (B b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> B a -> f (B b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> B a -> f (B b)
$csequenceA :: forall (f :: * -> *) a. Applicative f => B (f a) -> f (B a)
sequenceA :: forall (f :: * -> *) a. Applicative f => B (f a) -> f (B a)
$cmapM :: forall (m :: * -> *) a b. Monad m => (a -> m b) -> B a -> m (B b)
mapM :: forall (m :: * -> *) a b. Monad m => (a -> m b) -> B a -> m (B b)
$csequence :: forall (m :: * -> *) a. Monad m => B (m a) -> m (B a)
sequence :: forall (m :: * -> *) a. Monad m => B (m a) -> m (B a)
Traversable)

buildList :: B a -> [a]
buildList :: forall a. B a -> [a]
buildList B a
as = case B a
as of
  B a
Empty -> []
  Singleton a
a -> [a
a]
  Append B a
as1 B a
as2 -> case B a
as1 of
    B a
Empty -> B a -> [a]
forall a. B a -> [a]
buildList B a
as2
    Singleton a
a      -> a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: B a -> [a]
forall a. B a -> [a]
buildList B a
as2
    Append B a
as11 B a
as12 -> B a -> [a]
forall a. B a -> [a]
buildList (B a -> B a -> B a
forall a. B a -> B a -> B a
Append B a
as11 (B a -> B a -> B a
forall a. B a -> B a -> B a
Append B a
as12 B a
as2))

-- | Encoding into @Unicon a@ with partial decoding function.
data Encoding a b s t = Encoding Int (s -> Builder a) (Unicon b -> Maybe (t, Vector b))
  deriving stock ((forall a b. (a -> b) -> Encoding a b s a -> Encoding a b s b)
-> (forall a b. a -> Encoding a b s b -> Encoding a b s a)
-> Functor (Encoding a b s)
forall a b. a -> Encoding a b s b -> Encoding a b s a
forall a b. (a -> b) -> Encoding a b s a -> Encoding a b s b
forall a b s a b. a -> Encoding a b s b -> Encoding a b s a
forall a b s a b. (a -> b) -> Encoding a b s a -> Encoding a b s b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b s a b. (a -> b) -> Encoding a b s a -> Encoding a b s b
fmap :: forall a b. (a -> b) -> Encoding a b s a -> Encoding a b s b
$c<$ :: forall a b s a b. a -> Encoding a b s b -> Encoding a b s a
<$ :: forall a b. a -> Encoding a b s b -> Encoding a b s a
Functor)

encodeWith :: Encoding a b s t -> s -> Unicon a
encodeWith :: forall a b s t. Encoding a b s t -> s -> Unicon a
encodeWith (Encoding Int
_ s -> Builder a
enc Unicon b -> Maybe (t, Vector b)
_) = Builder a -> Unicon a
forall a. Builder a -> Unicon a
build (Builder a -> Unicon a) -> (s -> Builder a) -> s -> Unicon a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> Builder a
enc

decodeWith :: Encoding a b s t -> Unicon b -> Maybe t
decodeWith :: forall a b s t. Encoding a b s t -> Unicon b -> Maybe t
decodeWith (Encoding Int
_ s -> Builder a
_ Unicon b -> Maybe (t, Vector b)
dec) = ((t, Vector b) -> t) -> Maybe (t, Vector b) -> Maybe t
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (t, Vector b) -> t
forall a b. (a, b) -> a
fst (Maybe (t, Vector b) -> Maybe t)
-> (Unicon b -> Maybe (t, Vector b)) -> Unicon b -> Maybe t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Unicon b -> Maybe (t, Vector b)
dec

idEncoding :: Encoding a b a b
idEncoding :: forall a b. Encoding a b a b
idEncoding = Int
-> (a -> Builder a)
-> (Unicon b -> Maybe (b, Vector b))
-> Encoding a b a b
forall a b s t.
Int
-> (s -> Builder a)
-> (Unicon b -> Maybe (t, Vector b))
-> Encoding a b s t
Encoding Int
1 a -> Builder a
forall a. a -> Builder a
enc Unicon b -> Maybe (b, Vector b)
forall b. Unicon b -> Maybe (b, Vector b)
dec
  where
    enc :: a -> Builder a
    enc :: forall a. a -> Builder a
enc a
a = Int -> B a -> Builder a
forall a. Int -> B a -> Builder a
Builder Int
0 (a -> B a
forall a. a -> B a
Singleton a
a)

    dec :: Unicon b -> Maybe (b, Vector b)
    dec :: forall b. Unicon b -> Maybe (b, Vector b)
dec (MkUnicon Int
tag Vector b
bs) = do
      Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Int
tag Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
      Vector b -> Maybe (b, Vector b)
forall a. Vector a -> Maybe (a, Vector a)
V.uncons Vector b
bs

instance Profunctor (Encoding a b) where
  dimap :: forall a b c d.
(a -> b) -> (c -> d) -> Encoding a b b c -> Encoding a b a d
dimap a -> b
f c -> d
g (Encoding Int
n b -> Builder a
enc Unicon b -> Maybe (c, Vector b)
dec) = Int
-> (a -> Builder a)
-> (Unicon b -> Maybe (d, Vector b))
-> Encoding a b a d
forall a b s t.
Int
-> (s -> Builder a)
-> (Unicon b -> Maybe (t, Vector b))
-> Encoding a b s t
Encoding Int
n (b -> Builder a
enc (b -> Builder a) -> (a -> b) -> a -> Builder a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f) (((c, Vector b) -> (d, Vector b))
-> Maybe (c, Vector b) -> Maybe (d, Vector b)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((c -> d) -> (c, Vector b) -> (d, Vector b)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first c -> d
g) (Maybe (c, Vector b) -> Maybe (d, Vector b))
-> (Unicon b -> Maybe (c, Vector b))
-> Unicon b
-> Maybe (d, Vector b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Unicon b -> Maybe (c, Vector b)
dec)

instance Cartesian (Encoding a b) where
  proUnit :: forall a. Encoding a b a ()
proUnit = Int
-> (a -> Builder a)
-> (Unicon b -> Maybe ((), Vector b))
-> Encoding a b a ()
forall a b s t.
Int
-> (s -> Builder a)
-> (Unicon b -> Maybe (t, Vector b))
-> Encoding a b s t
Encoding Int
1 (Builder a -> a -> Builder a
forall a b. a -> b -> a
const Builder a
forall {a}. Builder a
one) Unicon b -> Maybe ((), Vector b)
forall {a}. Unicon a -> Maybe ((), Vector a)
matchOne
    where
      one :: Builder a
one = Int -> B a -> Builder a
forall a. Int -> B a -> Builder a
Builder Int
0 B a
forall a. B a
Empty
      matchOne :: Unicon a -> Maybe ((), Vector a)
matchOne (MkUnicon Int
0 Vector a
bs) = ((), Vector a) -> Maybe ((), Vector a)
forall a. a -> Maybe a
Just ((), Vector a
bs)
      matchOne Unicon a
_ = Maybe ((), Vector a)
forall a. Maybe a
Nothing

  Encoding Int
m a -> Builder a
enc Unicon b -> Maybe (b, Vector b)
dec *** :: forall a b a' b'.
Encoding a b a b
-> Encoding a b a' b' -> Encoding a b (a, a') (b, b')
*** Encoding Int
n a' -> Builder a
enc' Unicon b -> Maybe (b', Vector b)
dec' = Int
-> ((a, a') -> Builder a)
-> (Unicon b -> Maybe ((b, b'), Vector b))
-> Encoding a b (a, a') (b, b')
forall a b s t.
Int
-> (s -> Builder a)
-> (Unicon b -> Maybe (t, Vector b))
-> Encoding a b s t
Encoding (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
m) (a, a') -> Builder a
encPair Unicon b -> Maybe ((b, b'), Vector b)
decPair
    where
      encPair :: (a, a') -> Builder a
encPair (a
s,a'
s') = case (a -> Builder a
enc a
s, a' -> Builder a
enc' a'
s') of
        (Builder Int
j B a
as, Builder Int
k B a
as') -> Int -> B a -> Builder a
forall a. Int -> B a -> Builder a
Builder (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
k) (B a -> B a -> B a
forall a. B a -> B a -> B a
Append B a
as B a
as')
      decPair :: Unicon b -> Maybe ((b, b'), Vector b)
decPair (MkUnicon Int
i Vector b
bs)
        | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0      = Maybe ((b, b'), Vector b)
forall a. Maybe a
Nothing
        | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
n = Maybe ((b, b'), Vector b)
forall a. Maybe a
Nothing
        | Bool
otherwise  = do
              let (Int
j,Int
k) = Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
quotRem Int
i Int
n
              (t1, bs') <- Unicon b -> Maybe (b, Vector b)
dec (Int -> Vector b -> Unicon b
forall a. Int -> Vector a -> Unicon a
MkUnicon Int
j Vector b
bs)
              (t2, bs'') <- dec' (MkUnicon k bs')
              pure ((t1, t2), bs'')

instance Cocartesian (Encoding a b) where
  proEmpty :: forall b. Encoding a b Void b
proEmpty = Int
-> (Void -> Builder a)
-> (Unicon b -> Maybe (b, Vector b))
-> Encoding a b Void b
forall a b s t.
Int
-> (s -> Builder a)
-> (Unicon b -> Maybe (t, Vector b))
-> Encoding a b s t
Encoding Int
0 Void -> Builder a
forall b. Void -> b
forall (p :: * -> * -> *) b. Cocartesian p => p Void b
proEmpty (Maybe (b, Vector b) -> Unicon b -> Maybe (b, Vector b)
forall a b. a -> b -> a
const Maybe (b, Vector b)
forall a. Maybe a
Nothing)
  Encoding Int
m a -> Builder a
enc Unicon b -> Maybe (b, Vector b)
dec +++ :: forall a b a' b'.
Encoding a b a b
-> Encoding a b a' b' -> Encoding a b (Either a a') (Either b b')
+++ Encoding Int
n a' -> Builder a
enc' Unicon b -> Maybe (b', Vector b)
dec' = Int
-> (Either a a' -> Builder a)
-> (Unicon b -> Maybe (Either b b', Vector b))
-> Encoding a b (Either a a') (Either b b')
forall a b s t.
Int
-> (s -> Builder a)
-> (Unicon b -> Maybe (t, Vector b))
-> Encoding a b s t
Encoding (Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) Either a a' -> Builder a
encSum Unicon b -> Maybe (Either b b', Vector b)
decSum
    where
      encSum :: Either a a' -> Builder a
encSum (Left a
s) = a -> Builder a
enc a
s
      encSum (Right a'
s') = case a' -> Builder a
enc' a'
s' of
        Builder Int
k B a
bs' -> Int -> B a -> Builder a
forall a. Int -> B a -> Builder a
Builder (Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
k) B a
bs'

      decSum :: Unicon b -> Maybe (Either b b', Vector b)
decSum (MkUnicon Int
i Vector b
bs)
        | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = Maybe (Either b b', Vector b)
forall a. Maybe a
Nothing
        | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
m = (b -> Either b b') -> (b, Vector b) -> (Either b b', Vector b)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first b -> Either b b'
forall a b. a -> Either a b
Left ((b, Vector b) -> (Either b b', Vector b))
-> Maybe (b, Vector b) -> Maybe (Either b b', Vector b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Unicon b -> Maybe (b, Vector b)
dec (Int -> Vector b -> Unicon b
forall a. Int -> Vector a -> Unicon a
MkUnicon Int
i Vector b
bs)
        | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n = (b' -> Either b b') -> (b', Vector b) -> (Either b b', Vector b)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first b' -> Either b b'
forall a b. b -> Either a b
Right ((b', Vector b) -> (Either b b', Vector b))
-> Maybe (b', Vector b) -> Maybe (Either b b', Vector b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Unicon b -> Maybe (b', Vector b)
dec' (Int -> Vector b -> Unicon b
forall a. Int -> Vector a -> Unicon a
MkUnicon (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
m) Vector b
bs)
        | Bool
otherwise = Maybe (Either b b', Vector b)
forall a. Maybe a
Nothing