{-# LANGUAGE TemplateHaskellQuotes #-}

module Argo.Type.Array where

import qualified Argo.Decoder as Decoder
import qualified Argo.Literal as Literal
import qualified Control.DeepSeq as DeepSeq
import qualified Data.Array as Array
import qualified Data.ByteString.Builder as Builder
import qualified Language.Haskell.TH.Syntax as TH

newtype Array a
    = Array (Array.Array Int a)
    deriving (Array a -> Array a -> Bool
(Array a -> Array a -> Bool)
-> (Array a -> Array a -> Bool) -> Eq (Array a)
forall a. Eq a => Array a -> Array a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Array a -> Array a -> Bool
$c/= :: forall a. Eq a => Array a -> Array a -> Bool
== :: Array a -> Array a -> Bool
$c== :: forall a. Eq a => Array a -> Array a -> Bool
Eq, Int -> Array a -> ShowS
[Array a] -> ShowS
Array a -> String
(Int -> Array a -> ShowS)
-> (Array a -> String) -> ([Array a] -> ShowS) -> Show (Array a)
forall a. Show a => Int -> Array a -> ShowS
forall a. Show a => [Array a] -> ShowS
forall a. Show a => Array a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Array a] -> ShowS
$cshowList :: forall a. Show a => [Array a] -> ShowS
show :: Array a -> String
$cshow :: forall a. Show a => Array a -> String
showsPrec :: Int -> Array a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Array a -> ShowS
Show)

instance TH.Lift a => TH.Lift (Array a) where
    liftTyped :: Array a -> Q (TExp (Array a))
liftTyped (Array Array Int a
x) =
        let
            bounds :: (Int, Int)
bounds = Array Int a -> (Int, Int)
forall i e. Array i e -> (i, i)
Array.bounds Array Int a
x
            elems :: [a]
elems = Array Int a -> [a]
forall i e. Array i e -> [e]
Array.elems Array Int a
x
        in [|| Array $ Array.listArray bounds elems ||]

instance DeepSeq.NFData a => DeepSeq.NFData (Array a) where
    rnf :: Array a -> ()
rnf (Array Array Int a
x) = Array Int a -> ()
forall a. NFData a => a -> ()
DeepSeq.rnf Array Int a
x

encode :: (a -> Builder.Builder) -> Array a -> Builder.Builder
encode :: (a -> Builder) -> Array a -> Builder
encode a -> Builder
f (Array Array Int a
x) =
    Word8 -> Builder
Builder.word8 Word8
Literal.leftSquareBracket
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ((Int, a) -> Builder) -> [(Int, a)] -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap
        (\ (Int
i, a
e) -> (if Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0 then Word8 -> Builder
Builder.word8 Word8
Literal.comma else Builder
forall a. Monoid a => a
mempty)
            Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> a -> Builder
f a
e)
        (Array Int a -> [(Int, a)]
forall i e. Ix i => Array i e -> [(i, e)]
Array.assocs Array Int a
x)
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
Builder.word8 Word8
Literal.rightSquareBracket

decode :: Decoder.Decoder a -> Decoder.Decoder (Array a)
decode :: Decoder a -> Decoder (Array a)
decode Decoder a
f = do
    Word8 -> Decoder ()
Decoder.word8 Word8
Literal.leftSquareBracket
    Decoder ()
Decoder.spaces
    Array Int a
xs <- Decoder a -> Decoder (Array Int a)
forall a. Decoder a -> Decoder (Array Int a)
Decoder.array Decoder a
f
    Word8 -> Decoder ()
Decoder.word8 Word8
Literal.rightSquareBracket
    Decoder ()
Decoder.spaces
    Array a -> Decoder (Array a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Array a -> Decoder (Array a)) -> Array a -> Decoder (Array a)
forall a b. (a -> b) -> a -> b
$ Array Int a -> Array a
forall a. Array Int a -> Array a
Array Array Int a
xs