{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}

-- | Flat instances for the `array` package
module Flat.Instances.Array
  ()
where

import qualified Data.Array                    as A
import qualified Data.Array.Unboxed            as U
import           Data.Array.IArray
import           Flat.Class
import           Flat.Decoder
import           Flat.Encoder
import           Flat.Instances.Base            ( )
-- import Flat.Instances.Util
import           Flat.Instances.Mono

-- $setup
-- >>> :set -XFlexibleContexts
-- >>> import           Flat.Instances.Test
-- >>> import           Flat.Instances.Mono
-- >>> import           qualified Data.Array as A
-- >>> import           qualified Data.Array.Unboxed as U
-- >>> import           Data.Array.IArray
-- >>> import           Data.Word

{-|
Array is encoded as (lowBound,highBound,AsArray (elems array)):

>>> let arr = A.array ((1::Word,4::Word),(2,5)) [((1,4),11::Word),((1,5),22),((2,4),33),((2,5),44)] in tst (bounds arr,AsArray(elems arr)) == tst arr 
True

As it's easy to see:

>>> tst $ A.array ((1::Word,4::Word),(2,5)) [((1,4),11::Word),((1,5),22),((2,4),33),((2,5),44)]
(True,80,[1,4,2,5,4,11,22,33,44,0])

>>> tst $ A.array ((1,4),(2,5)) [((1,4),"1.4"),((1,5),"1.5"),((2,4),"2.4"),((2,5),"2.5")]
(True,160,[2,8,4,10,4,152,203,166,137,140,186,106,153,75,166,137,148,186,106,0])

Arrays and Unboxed Arrays are encoded in the same way:

>>> let bounds = ((1::Word,4::Word),(2,5));elems=[11::Word,22,33,44] in tst (U.listArray bounds elems :: U.UArray (Word,Word) Word) == tst (A.listArray bounds elems)
True
-}
instance (Flat i, Flat e, Ix i) => Flat (A.Array i e) where
  size :: Array i e -> NumBits -> NumBits
size   = forall (a :: * -> * -> *) e i.
(IArray a e, Ix i, Flat e, Flat i) =>
a i e -> NumBits -> NumBits
sizeIArray

  encode :: Array i e -> Encoding
encode = forall i (a :: * -> * -> *) e.
(Ix i, IArray a e, Flat i, Flat e) =>
a i e -> Encoding
encodeIArray

  decode :: Get (Array i e)
decode = forall i (a :: * -> * -> *) e.
(Ix i, IArray a e, Flat i, Flat e) =>
Get (a i e)
decodeIArray

instance (Flat i, Flat e, Ix i, IArray U.UArray e) => Flat (U.UArray i e) where
  size :: UArray i e -> NumBits -> NumBits
size   = forall (a :: * -> * -> *) e i.
(IArray a e, Ix i, Flat e, Flat i) =>
a i e -> NumBits -> NumBits
sizeIArray

  encode :: UArray i e -> Encoding
encode = forall i (a :: * -> * -> *) e.
(Ix i, IArray a e, Flat i, Flat e) =>
a i e -> Encoding
encodeIArray

  decode :: Get (UArray i e)
decode = forall i (a :: * -> * -> *) e.
(Ix i, IArray a e, Flat i, Flat e) =>
Get (a i e)
decodeIArray

sizeIArray :: (IArray a e, Ix i, Flat e, Flat i) => a i e -> NumBits -> NumBits
sizeIArray :: forall (a :: * -> * -> *) e i.
(IArray a e, Ix i, Flat e, Flat i) =>
a i e -> NumBits -> NumBits
sizeIArray a i e
arr = (forall mono.
(IsSequence mono, Flat (Element mono)) =>
mono -> NumBits -> NumBits
sizeSequence forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
elems forall a b. (a -> b) -> a -> b
$ a i e
arr) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Flat a => a -> NumBits -> NumBits
size (forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
bounds a i e
arr)

encodeIArray :: (Ix i, IArray a e, Flat i, Flat e) => a i e -> Encoding
encodeIArray :: forall i (a :: * -> * -> *) e.
(Ix i, IArray a e, Flat i, Flat e) =>
a i e -> Encoding
encodeIArray a i e
arr = forall a. Flat a => a -> Encoding
encode (forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
bounds a i e
arr) forall a. Semigroup a => a -> a -> a
<> forall mono.
(Flat (Element mono), MonoFoldable mono) =>
mono -> Encoding
encodeSequence (forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
elems a i e
arr)

decodeIArray :: (Ix i, IArray a e, Flat i, Flat e) => Get (a i e)
decodeIArray :: forall i (a :: * -> * -> *) e.
(Ix i, IArray a e, Flat i, Flat e) =>
Get (a i e)
decodeIArray = forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
listArray forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Flat a => Get a
decode forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall b. (Flat (Element b), IsSequence b) => Get b
decodeSequence

{-# INLINE sizeIArray #-}
{-# INLINE encodeIArray #-}
{-# INLINE decodeIArray #-}