{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE TypeFamilies #-}

module Data.Packed.Needs (
    -- * Type
    Needs (..),
    withEmptyNeeds,
    finish,

    -- * Builders
    NeedsBuilder (..),
    NeedsWriter,
    NeedsWriter',
    (>>),
    mkNeedsBuilder,
    withNeeds,

    -- * Mixing Needs together
    concatNeeds,
    applyNeeds,

    -- * Internal
    unsafeCastNeeds,
    (:++:),
) where

import ByteString.StrictBuilder
import Data.Kind
import Data.Packed.Packed
import Data.Packed.Utils
import Prelude hiding ((>>))

-- | A buffer where packed values can be written
-- The order to write these values is defined by the 'l' type list
--
-- If 'p' is an empty list, then a value of type 't' can be extracted from that buffer.
-- (See 'finish')
newtype Needs (p :: [Type]) (t :: [Type]) = Needs Builder

unsafeCastNeeds :: Needs a b -> Needs c d
unsafeCastNeeds :: forall (a :: [*]) (b :: [*]) (c :: [*]) (d :: [*]).
Needs a b -> Needs c d
unsafeCastNeeds (Needs Builder
b) = Builder -> Needs c d
forall (p :: [*]) (t :: [*]). Builder -> Needs p t
Needs Builder
b

-- | A wrapper around a function that builds a 'Needs'
--
-- 'ps': The type of the expected input of the source 'Needs'
--
-- 'ts': The type of the final packed data of the source 'Needs'
--
-- 'pd': The type of the expected input of the resuling 'Needs'
--
-- 'td': The type of the final packed data of the resulting 'Needs'
--
-- __Note:__ It is an indexed monad.
newtype NeedsBuilder ps ts pd td = NeedsBuilder
    { forall (ps :: [*]) (ts :: [*]) (pd :: [*]) (td :: [*]).
NeedsBuilder ps ts pd td -> Needs ps ts -> Needs pd td
runBuilder :: Needs ps ts -> Needs pd td
    }

(>>) :: NeedsBuilder p1 t1 p2 t2 -> NeedsBuilder p2 t2 p3 t3 -> NeedsBuilder p1 t1 p3 t3
(NeedsBuilder !Needs p1 t1 -> Needs p2 t2
b1) >> :: forall (p1 :: [*]) (t1 :: [*]) (p2 :: [*]) (t2 :: [*]) (p3 :: [*])
       (t3 :: [*]).
NeedsBuilder p1 t1 p2 t2
-> NeedsBuilder p2 t2 p3 t3 -> NeedsBuilder p1 t1 p3 t3
>> (NeedsBuilder !Needs p2 t2 -> Needs p3 t3
b2) = (Needs p1 t1 -> Needs p3 t3) -> NeedsBuilder p1 t1 p3 t3
forall (ps :: [*]) (ts :: [*]) (pd :: [*]) (td :: [*]).
(Needs ps ts -> Needs pd td) -> NeedsBuilder ps ts pd td
mkNeedsBuilder (\Needs p1 t1
n -> Needs p2 t2 -> Needs p3 t3
b2 (Needs p1 t1 -> Needs p2 t2
b1 Needs p1 t1
n))

-- | Shortcut type for 'NeedsBuilder'\'s that simply write a value to a 'Needs' without changing the final packed type
type NeedsWriter a r t = NeedsBuilder (a ': r) t r t

-- | Shortcut type for 'NeedsBuilder'\'s that simply write multiple values to a 'Needs' without changing the final packed type
type NeedsWriter' a r t = NeedsBuilder (a :++: r) t r t

mkNeedsBuilder :: (Needs ps ts -> Needs pd td) -> NeedsBuilder ps ts pd td
mkNeedsBuilder :: forall (ps :: [*]) (ts :: [*]) (pd :: [*]) (td :: [*]).
(Needs ps ts -> Needs pd td) -> NeedsBuilder ps ts pd td
mkNeedsBuilder = (Needs ps ts -> Needs pd td) -> NeedsBuilder ps ts pd td
forall (ps :: [*]) (ts :: [*]) (pd :: [*]) (td :: [*]).
(Needs ps ts -> Needs pd td) -> NeedsBuilder ps ts pd td
NeedsBuilder

withEmptyNeeds :: NeedsBuilder a b x y -> Needs x y
withEmptyNeeds :: forall (a :: [*]) (b :: [*]) (x :: [*]) (y :: [*]).
NeedsBuilder a b x y -> Needs x y
withEmptyNeeds (NeedsBuilder !Needs a b -> Needs x y
b) = Needs a b -> Needs x y
b (Builder -> Needs a b
forall (p :: [*]) (t :: [*]). Builder -> Needs p t
Needs Builder
forall a. Monoid a => a
mempty)

withNeeds :: Needs x y -> NeedsBuilder x y x1 y1 -> Needs x1 y1
withNeeds :: forall (x :: [*]) (y :: [*]) (x1 :: [*]) (y1 :: [*]).
Needs x y -> NeedsBuilder x y x1 y1 -> Needs x1 y1
withNeeds Needs x y
needs (NeedsBuilder !Needs x y -> Needs x1 y1
next) = Needs x y -> Needs x1 y1
next Needs x y
needs

concatNeeds :: Needs p t -> NeedsBuilder '[] t1 p (t1 :++: t)
concatNeeds :: forall (p :: [*]) (t :: [*]) (t1 :: [*]).
Needs p t -> NeedsBuilder '[] t1 p (t1 :++: t)
concatNeeds (Needs !Builder
b) = (Needs '[] t1 -> Needs p (t1 :++: t))
-> NeedsBuilder '[] t1 p (t1 :++: t)
forall (ps :: [*]) (ts :: [*]) (pd :: [*]) (td :: [*]).
(Needs ps ts -> Needs pd td) -> NeedsBuilder ps ts pd td
NeedsBuilder (\(Needs Builder
s) -> Builder -> Needs p (t1 :++: t)
forall (p :: [*]) (t :: [*]). Builder -> Needs p t
Needs (Builder
s Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
b))

applyNeeds :: Needs '[] t1 -> NeedsBuilder (t1 :++: r) t r t
applyNeeds :: forall (t1 :: [*]) (r :: [*]) (t :: [*]).
Needs '[] t1 -> NeedsBuilder (t1 :++: r) t r t
applyNeeds (Needs Builder
b) = (Needs (t1 :++: r) t -> Needs r t)
-> NeedsBuilder (t1 :++: r) t r t
forall (ps :: [*]) (ts :: [*]) (pd :: [*]) (td :: [*]).
(Needs ps ts -> Needs pd td) -> NeedsBuilder ps ts pd td
NeedsBuilder (\(Needs Builder
s) -> Builder -> Needs r t
forall (p :: [*]) (t :: [*]). Builder -> Needs p t
Needs (Builder
s Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
b))

-- | Turns a 'Needs' value (that does not expect to be written to) to a 'Data.Packed.Packed'
finish :: Needs '[] t -> Packed t
finish :: forall (t :: [*]). Needs '[] t -> Packed t
finish (Needs !Builder
b) = ByteString -> Packed t
forall (l :: [*]). ByteString -> Packed l
Packed (Builder -> ByteString
builderBytes Builder
b)