module DataFrame.IO.Parquet.Types where

import Data.Int
import qualified Data.Text as T
import Data.Time
import Data.Word

data ParquetType
    = PBOOLEAN
    | PINT32
    | PINT64
    | PINT96
    | PFLOAT
    | PDOUBLE
    | PBYTE_ARRAY
    | PFIXED_LEN_BYTE_ARRAY
    | PARQUET_TYPE_UNKNOWN
    deriving (Int -> ParquetType -> ShowS
[ParquetType] -> ShowS
ParquetType -> String
(Int -> ParquetType -> ShowS)
-> (ParquetType -> String)
-> ([ParquetType] -> ShowS)
-> Show ParquetType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ParquetType -> ShowS
showsPrec :: Int -> ParquetType -> ShowS
$cshow :: ParquetType -> String
show :: ParquetType -> String
$cshowList :: [ParquetType] -> ShowS
showList :: [ParquetType] -> ShowS
Show, ParquetType -> ParquetType -> Bool
(ParquetType -> ParquetType -> Bool)
-> (ParquetType -> ParquetType -> Bool) -> Eq ParquetType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ParquetType -> ParquetType -> Bool
== :: ParquetType -> ParquetType -> Bool
$c/= :: ParquetType -> ParquetType -> Bool
/= :: ParquetType -> ParquetType -> Bool
Eq)

parquetTypeFromInt :: Int32 -> ParquetType
parquetTypeFromInt :: Int32 -> ParquetType
parquetTypeFromInt Int32
0 = ParquetType
PBOOLEAN
parquetTypeFromInt Int32
1 = ParquetType
PINT32
parquetTypeFromInt Int32
2 = ParquetType
PINT64
parquetTypeFromInt Int32
3 = ParquetType
PINT96
parquetTypeFromInt Int32
4 = ParquetType
PFLOAT
parquetTypeFromInt Int32
5 = ParquetType
PDOUBLE
parquetTypeFromInt Int32
6 = ParquetType
PBYTE_ARRAY
parquetTypeFromInt Int32
7 = ParquetType
PFIXED_LEN_BYTE_ARRAY
parquetTypeFromInt Int32
_ = ParquetType
PARQUET_TYPE_UNKNOWN

data PageType
    = DATA_PAGE
    | INDEX_PAGE
    | DICTIONARY_PAGE
    | DATA_PAGE_V2
    | PAGE_TYPE_UNKNOWN
    deriving (Int -> PageType -> ShowS
[PageType] -> ShowS
PageType -> String
(Int -> PageType -> ShowS)
-> (PageType -> String) -> ([PageType] -> ShowS) -> Show PageType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PageType -> ShowS
showsPrec :: Int -> PageType -> ShowS
$cshow :: PageType -> String
show :: PageType -> String
$cshowList :: [PageType] -> ShowS
showList :: [PageType] -> ShowS
Show, PageType -> PageType -> Bool
(PageType -> PageType -> Bool)
-> (PageType -> PageType -> Bool) -> Eq PageType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PageType -> PageType -> Bool
== :: PageType -> PageType -> Bool
$c/= :: PageType -> PageType -> Bool
/= :: PageType -> PageType -> Bool
Eq)

pageTypeFromInt :: Int32 -> PageType
pageTypeFromInt :: Int32 -> PageType
pageTypeFromInt Int32
0 = PageType
DATA_PAGE
pageTypeFromInt Int32
1 = PageType
INDEX_PAGE
pageTypeFromInt Int32
2 = PageType
DICTIONARY_PAGE
pageTypeFromInt Int32
3 = PageType
DATA_PAGE_V2
pageTypeFromInt Int32
_ = PageType
PAGE_TYPE_UNKNOWN

data ParquetEncoding
    = EPLAIN
    | EPLAIN_DICTIONARY
    | ERLE
    | EBIT_PACKED
    | EDELTA_BINARY_PACKED
    | EDELTA_LENGTH_BYTE_ARRAY
    | EDELTA_BYTE_ARRAY
    | ERLE_DICTIONARY
    | EBYTE_STREAM_SPLIT
    | PARQUET_ENCODING_UNKNOWN
    deriving (Int -> ParquetEncoding -> ShowS
[ParquetEncoding] -> ShowS
ParquetEncoding -> String
(Int -> ParquetEncoding -> ShowS)
-> (ParquetEncoding -> String)
-> ([ParquetEncoding] -> ShowS)
-> Show ParquetEncoding
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ParquetEncoding -> ShowS
showsPrec :: Int -> ParquetEncoding -> ShowS
$cshow :: ParquetEncoding -> String
show :: ParquetEncoding -> String
$cshowList :: [ParquetEncoding] -> ShowS
showList :: [ParquetEncoding] -> ShowS
Show, ParquetEncoding -> ParquetEncoding -> Bool
(ParquetEncoding -> ParquetEncoding -> Bool)
-> (ParquetEncoding -> ParquetEncoding -> Bool)
-> Eq ParquetEncoding
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ParquetEncoding -> ParquetEncoding -> Bool
== :: ParquetEncoding -> ParquetEncoding -> Bool
$c/= :: ParquetEncoding -> ParquetEncoding -> Bool
/= :: ParquetEncoding -> ParquetEncoding -> Bool
Eq)

parquetEncodingFromInt :: Int32 -> ParquetEncoding
parquetEncodingFromInt :: Int32 -> ParquetEncoding
parquetEncodingFromInt Int32
0 = ParquetEncoding
EPLAIN
parquetEncodingFromInt Int32
2 = ParquetEncoding
EPLAIN_DICTIONARY
parquetEncodingFromInt Int32
3 = ParquetEncoding
ERLE
parquetEncodingFromInt Int32
4 = ParquetEncoding
EBIT_PACKED
parquetEncodingFromInt Int32
5 = ParquetEncoding
EDELTA_BINARY_PACKED
parquetEncodingFromInt Int32
6 = ParquetEncoding
EDELTA_LENGTH_BYTE_ARRAY
parquetEncodingFromInt Int32
7 = ParquetEncoding
EDELTA_BYTE_ARRAY
parquetEncodingFromInt Int32
8 = ParquetEncoding
ERLE_DICTIONARY
parquetEncodingFromInt Int32
9 = ParquetEncoding
EBYTE_STREAM_SPLIT
parquetEncodingFromInt Int32
_ = ParquetEncoding
PARQUET_ENCODING_UNKNOWN

data CompressionCodec
    = UNCOMPRESSED
    | SNAPPY
    | GZIP
    | LZO
    | BROTLI
    | LZ4
    | ZSTD
    | LZ4_RAW
    | COMPRESSION_CODEC_UNKNOWN
    deriving (Int -> CompressionCodec -> ShowS
[CompressionCodec] -> ShowS
CompressionCodec -> String
(Int -> CompressionCodec -> ShowS)
-> (CompressionCodec -> String)
-> ([CompressionCodec] -> ShowS)
-> Show CompressionCodec
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CompressionCodec -> ShowS
showsPrec :: Int -> CompressionCodec -> ShowS
$cshow :: CompressionCodec -> String
show :: CompressionCodec -> String
$cshowList :: [CompressionCodec] -> ShowS
showList :: [CompressionCodec] -> ShowS
Show, CompressionCodec -> CompressionCodec -> Bool
(CompressionCodec -> CompressionCodec -> Bool)
-> (CompressionCodec -> CompressionCodec -> Bool)
-> Eq CompressionCodec
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CompressionCodec -> CompressionCodec -> Bool
== :: CompressionCodec -> CompressionCodec -> Bool
$c/= :: CompressionCodec -> CompressionCodec -> Bool
/= :: CompressionCodec -> CompressionCodec -> Bool
Eq)

data PageEncodingStats = PageEncodingStats
    { PageEncodingStats -> PageType
pageEncodingPageType :: PageType
    , PageEncodingStats -> ParquetEncoding
pageEncoding :: ParquetEncoding
    , PageEncodingStats -> Int32
pagesWithEncoding :: Int32
    }
    deriving (Int -> PageEncodingStats -> ShowS
[PageEncodingStats] -> ShowS
PageEncodingStats -> String
(Int -> PageEncodingStats -> ShowS)
-> (PageEncodingStats -> String)
-> ([PageEncodingStats] -> ShowS)
-> Show PageEncodingStats
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PageEncodingStats -> ShowS
showsPrec :: Int -> PageEncodingStats -> ShowS
$cshow :: PageEncodingStats -> String
show :: PageEncodingStats -> String
$cshowList :: [PageEncodingStats] -> ShowS
showList :: [PageEncodingStats] -> ShowS
Show, PageEncodingStats -> PageEncodingStats -> Bool
(PageEncodingStats -> PageEncodingStats -> Bool)
-> (PageEncodingStats -> PageEncodingStats -> Bool)
-> Eq PageEncodingStats
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PageEncodingStats -> PageEncodingStats -> Bool
== :: PageEncodingStats -> PageEncodingStats -> Bool
$c/= :: PageEncodingStats -> PageEncodingStats -> Bool
/= :: PageEncodingStats -> PageEncodingStats -> Bool
Eq)

emptyPageEncodingStats :: PageEncodingStats
emptyPageEncodingStats :: PageEncodingStats
emptyPageEncodingStats = PageType -> ParquetEncoding -> Int32 -> PageEncodingStats
PageEncodingStats PageType
PAGE_TYPE_UNKNOWN ParquetEncoding
PARQUET_ENCODING_UNKNOWN Int32
0

data SizeStatistics = SizeStatisics
    { SizeStatistics -> Int64
unencodedByteArrayDataTypes :: Int64
    , SizeStatistics -> [Int64]
repetitionLevelHistogram :: [Int64]
    , SizeStatistics -> [Int64]
definitionLevelHistogram :: [Int64]
    }
    deriving (Int -> SizeStatistics -> ShowS
[SizeStatistics] -> ShowS
SizeStatistics -> String
(Int -> SizeStatistics -> ShowS)
-> (SizeStatistics -> String)
-> ([SizeStatistics] -> ShowS)
-> Show SizeStatistics
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SizeStatistics -> ShowS
showsPrec :: Int -> SizeStatistics -> ShowS
$cshow :: SizeStatistics -> String
show :: SizeStatistics -> String
$cshowList :: [SizeStatistics] -> ShowS
showList :: [SizeStatistics] -> ShowS
Show, SizeStatistics -> SizeStatistics -> Bool
(SizeStatistics -> SizeStatistics -> Bool)
-> (SizeStatistics -> SizeStatistics -> Bool) -> Eq SizeStatistics
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SizeStatistics -> SizeStatistics -> Bool
== :: SizeStatistics -> SizeStatistics -> Bool
$c/= :: SizeStatistics -> SizeStatistics -> Bool
/= :: SizeStatistics -> SizeStatistics -> Bool
Eq)

emptySizeStatistics :: SizeStatistics
emptySizeStatistics :: SizeStatistics
emptySizeStatistics = Int64 -> [Int64] -> [Int64] -> SizeStatistics
SizeStatisics Int64
0 [] []

data BoundingBox = BoundingBox
    { BoundingBox -> Double
xmin :: Double
    , BoundingBox -> Double
xmax :: Double
    , BoundingBox -> Double
ymin :: Double
    , BoundingBox -> Double
ymax :: Double
    , BoundingBox -> Double
zmin :: Double
    , BoundingBox -> Double
zmax :: Double
    , BoundingBox -> Double
mmin :: Double
    , BoundingBox -> Double
mmax :: Double
    }
    deriving (Int -> BoundingBox -> ShowS
[BoundingBox] -> ShowS
BoundingBox -> String
(Int -> BoundingBox -> ShowS)
-> (BoundingBox -> String)
-> ([BoundingBox] -> ShowS)
-> Show BoundingBox
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BoundingBox -> ShowS
showsPrec :: Int -> BoundingBox -> ShowS
$cshow :: BoundingBox -> String
show :: BoundingBox -> String
$cshowList :: [BoundingBox] -> ShowS
showList :: [BoundingBox] -> ShowS
Show, BoundingBox -> BoundingBox -> Bool
(BoundingBox -> BoundingBox -> Bool)
-> (BoundingBox -> BoundingBox -> Bool) -> Eq BoundingBox
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BoundingBox -> BoundingBox -> Bool
== :: BoundingBox -> BoundingBox -> Bool
$c/= :: BoundingBox -> BoundingBox -> Bool
/= :: BoundingBox -> BoundingBox -> Bool
Eq)

emptyBoundingBox :: BoundingBox
emptyBoundingBox :: BoundingBox
emptyBoundingBox = Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> BoundingBox
BoundingBox Double
0 Double
0 Double
0 Double
0 Double
0 Double
0 Double
0 Double
0

data GeospatialStatistics = GeospatialStatistics
    { GeospatialStatistics -> BoundingBox
bbox :: BoundingBox
    , GeospatialStatistics -> [Int32]
geospatialTypes :: [Int32]
    }
    deriving (Int -> GeospatialStatistics -> ShowS
[GeospatialStatistics] -> ShowS
GeospatialStatistics -> String
(Int -> GeospatialStatistics -> ShowS)
-> (GeospatialStatistics -> String)
-> ([GeospatialStatistics] -> ShowS)
-> Show GeospatialStatistics
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GeospatialStatistics -> ShowS
showsPrec :: Int -> GeospatialStatistics -> ShowS
$cshow :: GeospatialStatistics -> String
show :: GeospatialStatistics -> String
$cshowList :: [GeospatialStatistics] -> ShowS
showList :: [GeospatialStatistics] -> ShowS
Show, GeospatialStatistics -> GeospatialStatistics -> Bool
(GeospatialStatistics -> GeospatialStatistics -> Bool)
-> (GeospatialStatistics -> GeospatialStatistics -> Bool)
-> Eq GeospatialStatistics
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GeospatialStatistics -> GeospatialStatistics -> Bool
== :: GeospatialStatistics -> GeospatialStatistics -> Bool
$c/= :: GeospatialStatistics -> GeospatialStatistics -> Bool
/= :: GeospatialStatistics -> GeospatialStatistics -> Bool
Eq)

emptyGeospatialStatistics :: GeospatialStatistics
emptyGeospatialStatistics :: GeospatialStatistics
emptyGeospatialStatistics = BoundingBox -> [Int32] -> GeospatialStatistics
GeospatialStatistics BoundingBox
emptyBoundingBox []

data ColumnStatistics = ColumnStatistics
    { ColumnStatistics -> [Word8]
columnMin :: [Word8]
    , ColumnStatistics -> [Word8]
columnMax :: [Word8]
    , ColumnStatistics -> Int64
columnNullCount :: Int64
    , ColumnStatistics -> Int64
columnDistictCount :: Int64
    , ColumnStatistics -> [Word8]
columnMinValue :: [Word8]
    , ColumnStatistics -> [Word8]
columnMaxValue :: [Word8]
    , ColumnStatistics -> Bool
isColumnMaxValueExact :: Bool
    , ColumnStatistics -> Bool
isColumnMinValueExact :: Bool
    }
    deriving (Int -> ColumnStatistics -> ShowS
[ColumnStatistics] -> ShowS
ColumnStatistics -> String
(Int -> ColumnStatistics -> ShowS)
-> (ColumnStatistics -> String)
-> ([ColumnStatistics] -> ShowS)
-> Show ColumnStatistics
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ColumnStatistics -> ShowS
showsPrec :: Int -> ColumnStatistics -> ShowS
$cshow :: ColumnStatistics -> String
show :: ColumnStatistics -> String
$cshowList :: [ColumnStatistics] -> ShowS
showList :: [ColumnStatistics] -> ShowS
Show, ColumnStatistics -> ColumnStatistics -> Bool
(ColumnStatistics -> ColumnStatistics -> Bool)
-> (ColumnStatistics -> ColumnStatistics -> Bool)
-> Eq ColumnStatistics
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ColumnStatistics -> ColumnStatistics -> Bool
== :: ColumnStatistics -> ColumnStatistics -> Bool
$c/= :: ColumnStatistics -> ColumnStatistics -> Bool
/= :: ColumnStatistics -> ColumnStatistics -> Bool
Eq)

emptyColumnStatistics :: ColumnStatistics
emptyColumnStatistics :: ColumnStatistics
emptyColumnStatistics = [Word8]
-> [Word8]
-> Int64
-> Int64
-> [Word8]
-> [Word8]
-> Bool
-> Bool
-> ColumnStatistics
ColumnStatistics [] [] Int64
0 Int64
0 [] [] Bool
False Bool
False

data ColumnCryptoMetadata
    = COLUMN_CRYPTO_METADATA_UNKNOWN
    | ENCRYPTION_WITH_FOOTER_KEY
    | EncryptionWithColumnKey
        { ColumnCryptoMetadata -> [String]
columnCryptPathInSchema :: [String]
        , ColumnCryptoMetadata -> [Word8]
columnKeyMetadata :: [Word8]
        }
    deriving (Int -> ColumnCryptoMetadata -> ShowS
[ColumnCryptoMetadata] -> ShowS
ColumnCryptoMetadata -> String
(Int -> ColumnCryptoMetadata -> ShowS)
-> (ColumnCryptoMetadata -> String)
-> ([ColumnCryptoMetadata] -> ShowS)
-> Show ColumnCryptoMetadata
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ColumnCryptoMetadata -> ShowS
showsPrec :: Int -> ColumnCryptoMetadata -> ShowS
$cshow :: ColumnCryptoMetadata -> String
show :: ColumnCryptoMetadata -> String
$cshowList :: [ColumnCryptoMetadata] -> ShowS
showList :: [ColumnCryptoMetadata] -> ShowS
Show, ColumnCryptoMetadata -> ColumnCryptoMetadata -> Bool
(ColumnCryptoMetadata -> ColumnCryptoMetadata -> Bool)
-> (ColumnCryptoMetadata -> ColumnCryptoMetadata -> Bool)
-> Eq ColumnCryptoMetadata
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ColumnCryptoMetadata -> ColumnCryptoMetadata -> Bool
== :: ColumnCryptoMetadata -> ColumnCryptoMetadata -> Bool
$c/= :: ColumnCryptoMetadata -> ColumnCryptoMetadata -> Bool
/= :: ColumnCryptoMetadata -> ColumnCryptoMetadata -> Bool
Eq)

data SortingColumn = SortingColumn
    { SortingColumn -> Int32
columnIndex :: Int32
    , SortingColumn -> Bool
columnOrderDescending :: Bool
    , SortingColumn -> Bool
nullFirst :: Bool
    }
    deriving (Int -> SortingColumn -> ShowS
[SortingColumn] -> ShowS
SortingColumn -> String
(Int -> SortingColumn -> ShowS)
-> (SortingColumn -> String)
-> ([SortingColumn] -> ShowS)
-> Show SortingColumn
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SortingColumn -> ShowS
showsPrec :: Int -> SortingColumn -> ShowS
$cshow :: SortingColumn -> String
show :: SortingColumn -> String
$cshowList :: [SortingColumn] -> ShowS
showList :: [SortingColumn] -> ShowS
Show, SortingColumn -> SortingColumn -> Bool
(SortingColumn -> SortingColumn -> Bool)
-> (SortingColumn -> SortingColumn -> Bool) -> Eq SortingColumn
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SortingColumn -> SortingColumn -> Bool
== :: SortingColumn -> SortingColumn -> Bool
$c/= :: SortingColumn -> SortingColumn -> Bool
/= :: SortingColumn -> SortingColumn -> Bool
Eq)

emptySortingColumn :: SortingColumn
emptySortingColumn :: SortingColumn
emptySortingColumn = Int32 -> Bool -> Bool -> SortingColumn
SortingColumn Int32
0 Bool
False Bool
False

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

data EncryptionAlgorithm
    = ENCRYPTION_ALGORITHM_UNKNOWN
    | AesGcmV1
        { EncryptionAlgorithm -> [Word8]
aadPrefix :: [Word8]
        , EncryptionAlgorithm -> [Word8]
aadFileUnique :: [Word8]
        , EncryptionAlgorithm -> Bool
supplyAadPrefix :: Bool
        }
    | AesGcmCtrV1
        { aadPrefix :: [Word8]
        , aadFileUnique :: [Word8]
        , supplyAadPrefix :: Bool
        }
    deriving (Int -> EncryptionAlgorithm -> ShowS
[EncryptionAlgorithm] -> ShowS
EncryptionAlgorithm -> String
(Int -> EncryptionAlgorithm -> ShowS)
-> (EncryptionAlgorithm -> String)
-> ([EncryptionAlgorithm] -> ShowS)
-> Show EncryptionAlgorithm
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EncryptionAlgorithm -> ShowS
showsPrec :: Int -> EncryptionAlgorithm -> ShowS
$cshow :: EncryptionAlgorithm -> String
show :: EncryptionAlgorithm -> String
$cshowList :: [EncryptionAlgorithm] -> ShowS
showList :: [EncryptionAlgorithm] -> ShowS
Show, EncryptionAlgorithm -> EncryptionAlgorithm -> Bool
(EncryptionAlgorithm -> EncryptionAlgorithm -> Bool)
-> (EncryptionAlgorithm -> EncryptionAlgorithm -> Bool)
-> Eq EncryptionAlgorithm
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EncryptionAlgorithm -> EncryptionAlgorithm -> Bool
== :: EncryptionAlgorithm -> EncryptionAlgorithm -> Bool
$c/= :: EncryptionAlgorithm -> EncryptionAlgorithm -> Bool
/= :: EncryptionAlgorithm -> EncryptionAlgorithm -> Bool
Eq)

data DictVals
    = DBool [Bool]
    | DInt32 [Int32]
    | DInt64 [Int64]
    | DInt96 [UTCTime]
    | DFloat [Float]
    | DDouble [Double]
    | DText [T.Text]
    deriving (Int -> DictVals -> ShowS
[DictVals] -> ShowS
DictVals -> String
(Int -> DictVals -> ShowS)
-> (DictVals -> String) -> ([DictVals] -> ShowS) -> Show DictVals
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DictVals -> ShowS
showsPrec :: Int -> DictVals -> ShowS
$cshow :: DictVals -> String
show :: DictVals -> String
$cshowList :: [DictVals] -> ShowS
showList :: [DictVals] -> ShowS
Show, DictVals -> DictVals -> Bool
(DictVals -> DictVals -> Bool)
-> (DictVals -> DictVals -> Bool) -> Eq DictVals
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DictVals -> DictVals -> Bool
== :: DictVals -> DictVals -> Bool
$c/= :: DictVals -> DictVals -> Bool
/= :: DictVals -> DictVals -> Bool
Eq)

data Page = Page
    { Page -> PageHeader
pageHeader :: PageHeader
    , Page -> [Word8]
pageBytes :: [Word8]
    }
    deriving (Int -> Page -> ShowS
[Page] -> ShowS
Page -> String
(Int -> Page -> ShowS)
-> (Page -> String) -> ([Page] -> ShowS) -> Show Page
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Page -> ShowS
showsPrec :: Int -> Page -> ShowS
$cshow :: Page -> String
show :: Page -> String
$cshowList :: [Page] -> ShowS
showList :: [Page] -> ShowS
Show, Page -> Page -> Bool
(Page -> Page -> Bool) -> (Page -> Page -> Bool) -> Eq Page
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Page -> Page -> Bool
== :: Page -> Page -> Bool
$c/= :: Page -> Page -> Bool
/= :: Page -> Page -> Bool
Eq)

data PageHeader = PageHeader
    { PageHeader -> PageType
pageHeaderPageType :: PageType
    , PageHeader -> Int32
uncompressedPageSize :: Int32
    , PageHeader -> Int32
compressedPageSize :: Int32
    , PageHeader -> Int32
pageHeaderCrcChecksum :: Int32
    , PageHeader -> PageTypeHeader
pageTypeHeader :: PageTypeHeader
    }
    deriving (Int -> PageHeader -> ShowS
[PageHeader] -> ShowS
PageHeader -> String
(Int -> PageHeader -> ShowS)
-> (PageHeader -> String)
-> ([PageHeader] -> ShowS)
-> Show PageHeader
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PageHeader -> ShowS
showsPrec :: Int -> PageHeader -> ShowS
$cshow :: PageHeader -> String
show :: PageHeader -> String
$cshowList :: [PageHeader] -> ShowS
showList :: [PageHeader] -> ShowS
Show, PageHeader -> PageHeader -> Bool
(PageHeader -> PageHeader -> Bool)
-> (PageHeader -> PageHeader -> Bool) -> Eq PageHeader
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PageHeader -> PageHeader -> Bool
== :: PageHeader -> PageHeader -> Bool
$c/= :: PageHeader -> PageHeader -> Bool
/= :: PageHeader -> PageHeader -> Bool
Eq)

emptyPageHeader :: PageHeader
emptyPageHeader = PageType -> Int32 -> Int32 -> Int32 -> PageTypeHeader -> PageHeader
PageHeader PageType
PAGE_TYPE_UNKNOWN Int32
0 Int32
0 Int32
0 PageTypeHeader
PAGE_TYPE_HEADER_UNKNOWN

data PageTypeHeader
    = DataPageHeader
        { PageTypeHeader -> Int32
dataPageHeaderNumValues :: Int32
        , PageTypeHeader -> ParquetEncoding
dataPageHeaderEncoding :: ParquetEncoding
        , PageTypeHeader -> ParquetEncoding
definitionLevelEncoding :: ParquetEncoding
        , PageTypeHeader -> ParquetEncoding
repetitionLevelEncoding :: ParquetEncoding
        , PageTypeHeader -> ColumnStatistics
dataPageHeaderStatistics :: ColumnStatistics
        }
    | DataPageHeaderV2
        { PageTypeHeader -> Int32
dataPageHeaderV2NumValues :: Int32
        , PageTypeHeader -> Int32
dataPageHeaderV2NumNulls :: Int32
        , PageTypeHeader -> Int32
dataPageHeaderV2NumRows :: Int32
        , PageTypeHeader -> ParquetEncoding
dataPageHeaderV2Encoding :: ParquetEncoding
        , PageTypeHeader -> Int32
definitionLevelByteLength :: Int32
        , PageTypeHeader -> Int32
repetitionLevelByteLength :: Int32
        , PageTypeHeader -> Bool
dataPageHeaderV2IsCompressed :: Bool
        , PageTypeHeader -> ColumnStatistics
dataPageHeaderV2Statistics :: ColumnStatistics
        }
    | DictionaryPageHeader
        { PageTypeHeader -> Int32
dictionaryPageHeaderNumValues :: Int32
        , PageTypeHeader -> ParquetEncoding
dictionaryPageHeaderEncoding :: ParquetEncoding
        , PageTypeHeader -> Bool
dictionaryPageIsSorted :: Bool
        }
    | INDEX_PAGE_HEADER
    | PAGE_TYPE_HEADER_UNKNOWN
    deriving (Int -> PageTypeHeader -> ShowS
[PageTypeHeader] -> ShowS
PageTypeHeader -> String
(Int -> PageTypeHeader -> ShowS)
-> (PageTypeHeader -> String)
-> ([PageTypeHeader] -> ShowS)
-> Show PageTypeHeader
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PageTypeHeader -> ShowS
showsPrec :: Int -> PageTypeHeader -> ShowS
$cshow :: PageTypeHeader -> String
show :: PageTypeHeader -> String
$cshowList :: [PageTypeHeader] -> ShowS
showList :: [PageTypeHeader] -> ShowS
Show, PageTypeHeader -> PageTypeHeader -> Bool
(PageTypeHeader -> PageTypeHeader -> Bool)
-> (PageTypeHeader -> PageTypeHeader -> Bool) -> Eq PageTypeHeader
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PageTypeHeader -> PageTypeHeader -> Bool
== :: PageTypeHeader -> PageTypeHeader -> Bool
$c/= :: PageTypeHeader -> PageTypeHeader -> Bool
/= :: PageTypeHeader -> PageTypeHeader -> Bool
Eq)

emptyDictionaryPageHeader :: PageTypeHeader
emptyDictionaryPageHeader = Int32 -> ParquetEncoding -> Bool -> PageTypeHeader
DictionaryPageHeader Int32
0 ParquetEncoding
PARQUET_ENCODING_UNKNOWN Bool
False
emptyDataPageHeader :: PageTypeHeader
emptyDataPageHeader =
    Int32
-> ParquetEncoding
-> ParquetEncoding
-> ParquetEncoding
-> ColumnStatistics
-> PageTypeHeader
DataPageHeader
        Int32
0
        ParquetEncoding
PARQUET_ENCODING_UNKNOWN
        ParquetEncoding
PARQUET_ENCODING_UNKNOWN
        ParquetEncoding
PARQUET_ENCODING_UNKNOWN
        ColumnStatistics
emptyColumnStatistics
emptyDataPageHeaderV2 :: PageTypeHeader
emptyDataPageHeaderV2 =
    Int32
-> Int32
-> Int32
-> ParquetEncoding
-> Int32
-> Int32
-> Bool
-> ColumnStatistics
-> PageTypeHeader
DataPageHeaderV2
        Int32
0
        Int32
0
        Int32
0
        ParquetEncoding
PARQUET_ENCODING_UNKNOWN
        Int32
0
        Int32
0 {- default for v2 is compressed -}
        Bool
True
        ColumnStatistics
emptyColumnStatistics

data RepetitionType = REQUIRED | OPTIONAL | REPEATED | UNKNOWN_REPETITION_TYPE
    deriving (RepetitionType -> RepetitionType -> Bool
(RepetitionType -> RepetitionType -> Bool)
-> (RepetitionType -> RepetitionType -> Bool) -> Eq RepetitionType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RepetitionType -> RepetitionType -> Bool
== :: RepetitionType -> RepetitionType -> Bool
$c/= :: RepetitionType -> RepetitionType -> Bool
/= :: RepetitionType -> RepetitionType -> Bool
Eq, Int -> RepetitionType -> ShowS
[RepetitionType] -> ShowS
RepetitionType -> String
(Int -> RepetitionType -> ShowS)
-> (RepetitionType -> String)
-> ([RepetitionType] -> ShowS)
-> Show RepetitionType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RepetitionType -> ShowS
showsPrec :: Int -> RepetitionType -> ShowS
$cshow :: RepetitionType -> String
show :: RepetitionType -> String
$cshowList :: [RepetitionType] -> ShowS
showList :: [RepetitionType] -> ShowS
Show)

data LogicalType
    = STRING_TYPE
    | MAP_TYPE
    | LIST_TYPE
    | ENUM_TYPE
    | DECIMAL_TYPE
    | DATE_TYPE
    | DecimalType {LogicalType -> Int32
decimalTypePrecision :: Int32, LogicalType -> Int32
decimalTypeScale :: Int32}
    | TimeType {LogicalType -> Bool
isAdjustedToUTC :: Bool, LogicalType -> TimeUnit
unit :: TimeUnit}
    | -- This should probably have a different, more constrained TimeUnit type.
      TimestampType {isAdjustedToUTC :: Bool, unit :: TimeUnit}
    | IntType {LogicalType -> Int8
bitWidth :: Int8, LogicalType -> Bool
intIsSigned :: Bool}
    | LOGICAL_TYPE_UNKNOWN
    | JSON_TYPE
    | BSON_TYPE
    | UUID_TYPE
    | FLOAT16_TYPE
    | VariantType {LogicalType -> Int8
specificationVersion :: Int8}
    | GeometryType {LogicalType -> Text
crs :: T.Text}
    | GeographyType {crs :: T.Text, LogicalType -> EdgeInterpolationAlgorithm
algorithm :: EdgeInterpolationAlgorithm}
    deriving (LogicalType -> LogicalType -> Bool
(LogicalType -> LogicalType -> Bool)
-> (LogicalType -> LogicalType -> Bool) -> Eq LogicalType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LogicalType -> LogicalType -> Bool
== :: LogicalType -> LogicalType -> Bool
$c/= :: LogicalType -> LogicalType -> Bool
/= :: LogicalType -> LogicalType -> Bool
Eq, Int -> LogicalType -> ShowS
[LogicalType] -> ShowS
LogicalType -> String
(Int -> LogicalType -> ShowS)
-> (LogicalType -> String)
-> ([LogicalType] -> ShowS)
-> Show LogicalType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LogicalType -> ShowS
showsPrec :: Int -> LogicalType -> ShowS
$cshow :: LogicalType -> String
show :: LogicalType -> String
$cshowList :: [LogicalType] -> ShowS
showList :: [LogicalType] -> ShowS
Show)

data TimeUnit
    = MILLISECONDS
    | MICROSECONDS
    | NANOSECONDS
    | TIME_UNIT_UNKNOWN
    deriving (TimeUnit -> TimeUnit -> Bool
(TimeUnit -> TimeUnit -> Bool)
-> (TimeUnit -> TimeUnit -> Bool) -> Eq TimeUnit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TimeUnit -> TimeUnit -> Bool
== :: TimeUnit -> TimeUnit -> Bool
$c/= :: TimeUnit -> TimeUnit -> Bool
/= :: TimeUnit -> TimeUnit -> Bool
Eq, Int -> TimeUnit -> ShowS
[TimeUnit] -> ShowS
TimeUnit -> String
(Int -> TimeUnit -> ShowS)
-> (TimeUnit -> String) -> ([TimeUnit] -> ShowS) -> Show TimeUnit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TimeUnit -> ShowS
showsPrec :: Int -> TimeUnit -> ShowS
$cshow :: TimeUnit -> String
show :: TimeUnit -> String
$cshowList :: [TimeUnit] -> ShowS
showList :: [TimeUnit] -> ShowS
Show)

data EdgeInterpolationAlgorithm
    = SPHERICAL
    | VINCENTY
    | THOMAS
    | ANDOYER
    | KARNEY
    deriving (EdgeInterpolationAlgorithm -> EdgeInterpolationAlgorithm -> Bool
(EdgeInterpolationAlgorithm -> EdgeInterpolationAlgorithm -> Bool)
-> (EdgeInterpolationAlgorithm
    -> EdgeInterpolationAlgorithm -> Bool)
-> Eq EdgeInterpolationAlgorithm
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EdgeInterpolationAlgorithm -> EdgeInterpolationAlgorithm -> Bool
== :: EdgeInterpolationAlgorithm -> EdgeInterpolationAlgorithm -> Bool
$c/= :: EdgeInterpolationAlgorithm -> EdgeInterpolationAlgorithm -> Bool
/= :: EdgeInterpolationAlgorithm -> EdgeInterpolationAlgorithm -> Bool
Eq, Int -> EdgeInterpolationAlgorithm -> ShowS
[EdgeInterpolationAlgorithm] -> ShowS
EdgeInterpolationAlgorithm -> String
(Int -> EdgeInterpolationAlgorithm -> ShowS)
-> (EdgeInterpolationAlgorithm -> String)
-> ([EdgeInterpolationAlgorithm] -> ShowS)
-> Show EdgeInterpolationAlgorithm
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EdgeInterpolationAlgorithm -> ShowS
showsPrec :: Int -> EdgeInterpolationAlgorithm -> ShowS
$cshow :: EdgeInterpolationAlgorithm -> String
show :: EdgeInterpolationAlgorithm -> String
$cshowList :: [EdgeInterpolationAlgorithm] -> ShowS
showList :: [EdgeInterpolationAlgorithm] -> ShowS
Show)

repetitionTypeFromInt :: Int32 -> RepetitionType
repetitionTypeFromInt :: Int32 -> RepetitionType
repetitionTypeFromInt Int32
0 = RepetitionType
REQUIRED
repetitionTypeFromInt Int32
1 = RepetitionType
OPTIONAL
repetitionTypeFromInt Int32
2 = RepetitionType
REPEATED
repetitionTypeFromInt Int32
_ = RepetitionType
UNKNOWN_REPETITION_TYPE

compressionCodecFromInt :: Int32 -> CompressionCodec
compressionCodecFromInt :: Int32 -> CompressionCodec
compressionCodecFromInt Int32
0 = CompressionCodec
UNCOMPRESSED
compressionCodecFromInt Int32
1 = CompressionCodec
SNAPPY
compressionCodecFromInt Int32
2 = CompressionCodec
GZIP
compressionCodecFromInt Int32
3 = CompressionCodec
LZO
compressionCodecFromInt Int32
4 = CompressionCodec
BROTLI
compressionCodecFromInt Int32
5 = CompressionCodec
LZ4
compressionCodecFromInt Int32
6 = CompressionCodec
ZSTD
compressionCodecFromInt Int32
7 = CompressionCodec
LZ4_RAW
compressionCodecFromInt Int32
_ = CompressionCodec
COMPRESSION_CODEC_UNKNOWN