-- Copyright (c) 2016-present, Facebook, Inc.
-- Copyright (c) 2019-present, Luis Pedro Coelho
-- All rights reserved.
--
-- This source code is licensed under the BSD-style license found in
-- the LICENSE file in the root directory of this source tree. An
-- additional grant of patent rights can be found in the PATENTS file
-- in the same directory.

{-# LANGUAGE BangPatterns #-}

-- |
-- Module      : Codec.Compression.Zstd.Types
-- Copyright   : (c) 2016-present, Facebook, Inc. All rights reserved.
--
-- License     : BSD3
-- Maintainer  : bryano@fb.com
-- Stability   : experimental
-- Portability : GHC
--
-- Types supporting zstd compression and decompression.

module Codec.Compression.Zstd.Types
    (
      Decompress(..)
    , Dict(..)
    , mkDict
    ) where

import Control.DeepSeq (NFData(..))
import Data.ByteString (ByteString)

-- | The result of a decompression operation.
data Decompress =
    Skip
  -- ^ Either the compressed frame was empty, or it was compressed in
  -- streaming mode and so its size is not known.
  | Error String
  -- ^ An error occurred.
  | Decompress ByteString
  -- ^ The payload was successfully decompressed.
  deriving (Decompress -> Decompress -> Bool
(Decompress -> Decompress -> Bool)
-> (Decompress -> Decompress -> Bool) -> Eq Decompress
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Decompress -> Decompress -> Bool
$c/= :: Decompress -> Decompress -> Bool
== :: Decompress -> Decompress -> Bool
$c== :: Decompress -> Decompress -> Bool
Eq, ReadPrec [Decompress]
ReadPrec Decompress
Int -> ReadS Decompress
ReadS [Decompress]
(Int -> ReadS Decompress)
-> ReadS [Decompress]
-> ReadPrec Decompress
-> ReadPrec [Decompress]
-> Read Decompress
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Decompress]
$creadListPrec :: ReadPrec [Decompress]
readPrec :: ReadPrec Decompress
$creadPrec :: ReadPrec Decompress
readList :: ReadS [Decompress]
$creadList :: ReadS [Decompress]
readsPrec :: Int -> ReadS Decompress
$creadsPrec :: Int -> ReadS Decompress
Read, Int -> Decompress -> ShowS
[Decompress] -> ShowS
Decompress -> String
(Int -> Decompress -> ShowS)
-> (Decompress -> String)
-> ([Decompress] -> ShowS)
-> Show Decompress
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Decompress] -> ShowS
$cshowList :: [Decompress] -> ShowS
show :: Decompress -> String
$cshow :: Decompress -> String
showsPrec :: Int -> Decompress -> ShowS
$cshowsPrec :: Int -> Decompress -> ShowS
Show)

-- | Compression dictionary.
newtype Dict = Dict {
    Dict -> ByteString
fromDict :: ByteString
  } deriving (Dict -> Dict -> Bool
(Dict -> Dict -> Bool) -> (Dict -> Dict -> Bool) -> Eq Dict
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Dict -> Dict -> Bool
$c/= :: Dict -> Dict -> Bool
== :: Dict -> Dict -> Bool
$c== :: Dict -> Dict -> Bool
Eq, Eq Dict
Eq Dict
-> (Dict -> Dict -> Ordering)
-> (Dict -> Dict -> Bool)
-> (Dict -> Dict -> Bool)
-> (Dict -> Dict -> Bool)
-> (Dict -> Dict -> Bool)
-> (Dict -> Dict -> Dict)
-> (Dict -> Dict -> Dict)
-> Ord Dict
Dict -> Dict -> Bool
Dict -> Dict -> Ordering
Dict -> Dict -> Dict
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
min :: Dict -> Dict -> Dict
$cmin :: Dict -> Dict -> Dict
max :: Dict -> Dict -> Dict
$cmax :: Dict -> Dict -> Dict
>= :: Dict -> Dict -> Bool
$c>= :: Dict -> Dict -> Bool
> :: Dict -> Dict -> Bool
$c> :: Dict -> Dict -> Bool
<= :: Dict -> Dict -> Bool
$c<= :: Dict -> Dict -> Bool
< :: Dict -> Dict -> Bool
$c< :: Dict -> Dict -> Bool
compare :: Dict -> Dict -> Ordering
$ccompare :: Dict -> Dict -> Ordering
$cp1Ord :: Eq Dict
Ord)

-- | Smart constructor.
mkDict :: ByteString -> Dict
mkDict :: ByteString -> Dict
mkDict ByteString
d = ByteString -> Dict
Dict ByteString
d

instance Show Dict where
    showsPrec :: Int -> Dict -> ShowS
showsPrec Int
n (Dict ByteString
d) String
r = Int -> ByteString -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
n ByteString
d String
r

instance Read Dict where
    readsPrec :: Int -> ReadS Dict
readsPrec Int
n String
s = ((ByteString, String) -> (Dict, String))
-> [(ByteString, String)] -> [(Dict, String)]
forall a b. (a -> b) -> [a] -> [b]
map (\(ByteString
a,String
b) -> (ByteString -> Dict
Dict ByteString
a, String
b)) (Int -> ReadS ByteString
forall a. Read a => Int -> ReadS a
readsPrec Int
n String
s)

instance NFData Dict where
    rnf :: Dict -> ()
rnf (Dict ByteString
d) = ByteString -> ()
forall a. NFData a => a -> ()
rnf ByteString
d