{-# LANGUAGE FlexibleInstances, DeriveTraversable #-}

-- | The endpoints on the cloud server
module Development.Shake.Internal.History.Serialise(
    BuildTree(..),
    WithTypeReps(..), withTypeReps,
    WithKeys(..), withKeys, withIds, withoutKeys,
    SendAllKeys(..), RecvAllKeys(..),
    SendOneKey(..), RecvOneKey(..),
    SendDownloadFiles(..),
    SendUpload(..)
    ) where

import Development.Shake.Internal.History.Bloom
import General.Extra
import General.Binary
import General.Ids
import Data.List.Extra
import Development.Shake.Internal.Value
import Development.Shake.Internal.FileInfo
import Development.Shake.Internal.History.Types
import qualified Data.HashMap.Strict as Map
import Data.Semigroup
import Data.Typeable
import Prelude


data BuildTree key
    -- invariant: Entries are sorted
    = Depend [key] [([BS_Identity], BuildTree key)]
    | Done BS_Store [(FilePath, FileSize, FileHash)]

instance BinaryEx (BuildTree Int) where
    getEx :: ByteString -> BuildTree Int
getEx = forall a. HasCallStack => a
undefined
    putEx :: BuildTree Int -> Builder
putEx = forall a. HasCallStack => a
undefined

instance Eq key => Semigroup (BuildTree key) where
    Depend [key]
ks1 [([ByteString], BuildTree key)]
vs1 <> :: BuildTree key -> BuildTree key -> BuildTree key
<> Depend [key]
ks2 [([ByteString], BuildTree key)]
vs2
        | [key]
ks1 forall a. Eq a => a -> a -> Bool
== [key]
ks2 = forall key.
[key] -> [([ByteString], BuildTree key)] -> BuildTree key
Depend [key]
ks1 forall a b. (a -> b) -> a -> b
$ forall a. (a -> a -> Ordering) -> [a] -> [a] -> [a]
mergeBy forall a. HasCallStack => a
undefined [([ByteString], BuildTree key)]
vs1 [([ByteString], BuildTree key)]
vs2
        | Bool
otherwise = forall key.
[key] -> [([ByteString], BuildTree key)] -> BuildTree key
Depend [key]
ks2 [([ByteString], BuildTree key)]
vs2 -- this shouldn't happen, so give up
    x :: BuildTree key
x@Done{} <> BuildTree key
_ = BuildTree key
x
    BuildTree key
_ <> y :: BuildTree key
y@Done{} = BuildTree key
y

instance Eq key => Monoid (BuildTree key) where
    mempty :: BuildTree key
mempty = forall key.
[key] -> [([ByteString], BuildTree key)] -> BuildTree key
Depend [] []
    mappend :: BuildTree key -> BuildTree key -> BuildTree key
mappend = forall a. Semigroup a => a -> a -> a
(<>)


data WithTypeReps a = WithTypeReps [BS_QTypeRep] a

instance BinaryEx a => BinaryEx (WithTypeReps a) where
    putEx :: WithTypeReps a -> Builder
putEx = forall a. HasCallStack => a
undefined
    getEx :: ByteString -> WithTypeReps a
getEx = forall a. HasCallStack => a
undefined

withTypeReps :: Traversable f => f TypeRep -> WithTypeReps (f Int)
withTypeReps :: forall (f :: * -> *).
Traversable f =>
f TypeRep -> WithTypeReps (f Int)
withTypeReps = forall a. HasCallStack => a
undefined

data WithKeys a = WithKeys [BS_Key] a

instance BinaryEx a => BinaryEx (WithKeys a) where
    putEx :: WithKeys a -> Builder
putEx = forall a. HasCallStack => a
undefined
    getEx :: ByteString -> WithKeys a
getEx = forall a. HasCallStack => a
undefined

withKeys :: Traversable f => f Key -> WithKeys (f Int)
withKeys :: forall (f :: * -> *). Traversable f => f Key -> WithKeys (f Int)
withKeys = forall a. HasCallStack => a
undefined

withIds :: Traversable f => (Id -> m Key) -> f Id -> m (WithKeys (f Int))
withIds :: forall (f :: * -> *) (m :: * -> *).
Traversable f =>
(Id -> m Key) -> f Id -> m (WithKeys (f Int))
withIds = forall a. HasCallStack => a
undefined

withoutKeys :: Map.HashMap TypeRep (BinaryOp Key) -> WithKeys (f Int) -> f Key
withoutKeys :: forall (f :: * -> *).
HashMap TypeRep (BinaryOp Key) -> WithKeys (f Int) -> f Key
withoutKeys = forall a. HasCallStack => a
undefined

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

instance BinaryEx (SendAllKeys Int) where
    putEx :: SendAllKeys Int -> Builder
putEx = forall a. HasCallStack => a
undefined
    getEx :: ByteString -> SendAllKeys Int
getEx = forall a. HasCallStack => a
undefined

newtype RecvAllKeys key = RecvAllKeys [(key, Ver, [key], Bloom [BS_Identity])]

instance BinaryEx (RecvAllKeys Int) where
    getEx :: ByteString -> RecvAllKeys Int
getEx = forall a. HasCallStack => a
undefined
    putEx :: RecvAllKeys Int -> Builder
putEx = forall a. HasCallStack => a
undefined

data SendOneKey key = SendOneKey Ver key Ver Ver [(key, BS_Identity)]

instance BinaryEx (SendOneKey Int) where
    getEx :: ByteString -> SendOneKey Int
getEx = forall a. HasCallStack => a
undefined
    putEx :: SendOneKey Int -> Builder
putEx = forall a. HasCallStack => a
undefined

newtype RecvOneKey key = RecvOneKey (BuildTree key)

instance BinaryEx (RecvOneKey Int) where
    getEx :: ByteString -> RecvOneKey Int
getEx = forall a. HasCallStack => a
undefined
    putEx :: RecvOneKey Int -> Builder
putEx = forall a. HasCallStack => a
undefined

data SendDownloadFiles key = SendDownloadFiles Ver key Ver Ver [(FilePath, FileSize, FileHash)]

instance BinaryEx (SendDownloadFiles Int) where
    getEx :: ByteString -> SendDownloadFiles Int
getEx = forall a. HasCallStack => a
undefined
    putEx :: SendDownloadFiles Int -> Builder
putEx = forall a. HasCallStack => a
undefined

data SendUpload key = SendUpload Ver key Ver Ver [[(key, BS_Identity)]] BS_Store [(FilePath, FileSize, FileHash)]

instance BinaryEx (SendUpload Int) where
    getEx :: ByteString -> SendUpload Int
getEx = forall a. HasCallStack => a
undefined
    putEx :: SendUpload Int -> Builder
putEx = forall a. HasCallStack => a
undefined