{-# LANGUAGE PatternSynonyms #-}
{-# OPTIONS_HADDOCK not-home #-}

module Database.LSMTree.Internal.Paths (
    SessionRoot (..)
  , lockFile
  , ActiveDir (..)
  , activeDir
  , runPath
  , SnapshotName
  , toSnapshotName
  , isValidSnapshotName
  , InvalidSnapshotNameError (..)
  , snapshotsDir
  , NamedSnapshotDir (..)
  , namedSnapshotDir
  , SnapshotMetaDataFile (..)
  , snapshotMetaDataFile
  , SnapshotMetaDataChecksumFile (..)
  , snapshotMetaDataChecksumFile
    -- * Table paths
  , tableBlobPath
    -- * Run paths
  , RunFsPaths (..)
  , pathsForRunFiles
  , runKOpsPath
  , runBlobPath
  , runFilterPath
  , runIndexPath
  , runChecksumsPath
    -- * Checksums for Run files
  , checksumFileNamesForRunFiles
  , toChecksumsFile
  , fromChecksumsFile
    -- * Checksums for WriteBuffer files
  , toChecksumsFileForWriteBufferFiles
  , fromChecksumsFileForWriteBufferFiles
    -- * ForRunFiles abstraction
  , ForKOps (..)
  , ForBlob (..)
  , ForFilter (..)
  , ForIndex (..)
  , ForRunFiles (..)
  , forRunKOpsRaw
  , forRunBlobRaw
  , forRunFilterRaw
  , forRunIndexRaw
    -- * WriteBuffer paths
  , WriteBufferFsPaths (WrapRunFsPaths, WriteBufferFsPaths, writeBufferDir, writeBufferNumber)
  , writeBufferKOpsPath
  , writeBufferBlobPath
  , writeBufferChecksumsPath
  , writeBufferFilePathWithExt
  ) where

import           Control.Applicative (Applicative (..))
import           Control.DeepSeq (NFData (..))
import           Control.Exception.Base (throw)
import           Control.Monad.Class.MonadThrow (Exception)
import qualified Data.ByteString.Char8 as BS
import           Data.Foldable (toList)
import qualified Data.Map as Map
import           Data.String (IsString (..))
import           Data.Traversable (for)
import qualified Database.LSMTree.Internal.CRC32C as CRC
import           Database.LSMTree.Internal.RunNumber
import           Database.LSMTree.Internal.UniqCounter
import           Prelude hiding (Applicative (..))
import qualified System.FilePath.Posix
import qualified System.FilePath.Windows
import           System.FS.API


newtype SessionRoot = SessionRoot { SessionRoot -> FsPath
getSessionRoot :: FsPath }
  deriving stock SessionRoot -> SessionRoot -> Bool
(SessionRoot -> SessionRoot -> Bool)
-> (SessionRoot -> SessionRoot -> Bool) -> Eq SessionRoot
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SessionRoot -> SessionRoot -> Bool
== :: SessionRoot -> SessionRoot -> Bool
$c/= :: SessionRoot -> SessionRoot -> Bool
/= :: SessionRoot -> SessionRoot -> Bool
Eq

lockFile :: SessionRoot -> FsPath
lockFile :: SessionRoot -> FsPath
lockFile (SessionRoot FsPath
dir) = FsPath
dir FsPath -> FsPath -> FsPath
</> [String] -> FsPath
mkFsPath [String
"lock"]

newtype ActiveDir = ActiveDir { ActiveDir -> FsPath
getActiveDir :: FsPath }

activeDir :: SessionRoot -> ActiveDir
activeDir :: SessionRoot -> ActiveDir
activeDir (SessionRoot FsPath
dir) = FsPath -> ActiveDir
ActiveDir (FsPath
dir FsPath -> FsPath -> FsPath
</> [String] -> FsPath
mkFsPath [String
"active"])

runPath :: ActiveDir -> RunNumber -> RunFsPaths
runPath :: ActiveDir -> RunNumber -> RunFsPaths
runPath (ActiveDir FsPath
dir) = FsPath -> RunNumber -> RunFsPaths
RunFsPaths FsPath
dir


{-------------------------------------------------------------------------------
  Snapshot name
-------------------------------------------------------------------------------}

newtype SnapshotName = SnapshotName FilePath
  deriving stock (SnapshotName -> SnapshotName -> Bool
(SnapshotName -> SnapshotName -> Bool)
-> (SnapshotName -> SnapshotName -> Bool) -> Eq SnapshotName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SnapshotName -> SnapshotName -> Bool
== :: SnapshotName -> SnapshotName -> Bool
$c/= :: SnapshotName -> SnapshotName -> Bool
/= :: SnapshotName -> SnapshotName -> Bool
Eq, Eq SnapshotName
Eq SnapshotName =>
(SnapshotName -> SnapshotName -> Ordering)
-> (SnapshotName -> SnapshotName -> Bool)
-> (SnapshotName -> SnapshotName -> Bool)
-> (SnapshotName -> SnapshotName -> Bool)
-> (SnapshotName -> SnapshotName -> Bool)
-> (SnapshotName -> SnapshotName -> SnapshotName)
-> (SnapshotName -> SnapshotName -> SnapshotName)
-> Ord SnapshotName
SnapshotName -> SnapshotName -> Bool
SnapshotName -> SnapshotName -> Ordering
SnapshotName -> SnapshotName -> SnapshotName
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
$ccompare :: SnapshotName -> SnapshotName -> Ordering
compare :: SnapshotName -> SnapshotName -> Ordering
$c< :: SnapshotName -> SnapshotName -> Bool
< :: SnapshotName -> SnapshotName -> Bool
$c<= :: SnapshotName -> SnapshotName -> Bool
<= :: SnapshotName -> SnapshotName -> Bool
$c> :: SnapshotName -> SnapshotName -> Bool
> :: SnapshotName -> SnapshotName -> Bool
$c>= :: SnapshotName -> SnapshotName -> Bool
>= :: SnapshotName -> SnapshotName -> Bool
$cmax :: SnapshotName -> SnapshotName -> SnapshotName
max :: SnapshotName -> SnapshotName -> SnapshotName
$cmin :: SnapshotName -> SnapshotName -> SnapshotName
min :: SnapshotName -> SnapshotName -> SnapshotName
Ord)

instance Show SnapshotName where
  showsPrec :: Int -> SnapshotName -> ShowS
showsPrec Int
d (SnapshotName String
p) = Int -> String -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d String
p

-- | The given string must satsify 'isValidSnapshotName'.
--   Otherwise, 'fromString' throws an 'InvalidSnapshotNameError'.
instance IsString SnapshotName where
  fromString :: String -> SnapshotName
  fromString :: String -> SnapshotName
fromString = String -> SnapshotName
toSnapshotName

data InvalidSnapshotNameError
  = ErrSnapshotNameInvalid !String
  deriving stock (Int -> InvalidSnapshotNameError -> ShowS
[InvalidSnapshotNameError] -> ShowS
InvalidSnapshotNameError -> String
(Int -> InvalidSnapshotNameError -> ShowS)
-> (InvalidSnapshotNameError -> String)
-> ([InvalidSnapshotNameError] -> ShowS)
-> Show InvalidSnapshotNameError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InvalidSnapshotNameError -> ShowS
showsPrec :: Int -> InvalidSnapshotNameError -> ShowS
$cshow :: InvalidSnapshotNameError -> String
show :: InvalidSnapshotNameError -> String
$cshowList :: [InvalidSnapshotNameError] -> ShowS
showList :: [InvalidSnapshotNameError] -> ShowS
Show)
  deriving anyclass (Show InvalidSnapshotNameError
Typeable InvalidSnapshotNameError
(Typeable InvalidSnapshotNameError,
 Show InvalidSnapshotNameError) =>
(InvalidSnapshotNameError -> SomeException)
-> (SomeException -> Maybe InvalidSnapshotNameError)
-> (InvalidSnapshotNameError -> String)
-> Exception InvalidSnapshotNameError
SomeException -> Maybe InvalidSnapshotNameError
InvalidSnapshotNameError -> String
InvalidSnapshotNameError -> SomeException
forall e.
(Typeable e, Show e) =>
(e -> SomeException)
-> (SomeException -> Maybe e) -> (e -> String) -> Exception e
$ctoException :: InvalidSnapshotNameError -> SomeException
toException :: InvalidSnapshotNameError -> SomeException
$cfromException :: SomeException -> Maybe InvalidSnapshotNameError
fromException :: SomeException -> Maybe InvalidSnapshotNameError
$cdisplayException :: InvalidSnapshotNameError -> String
displayException :: InvalidSnapshotNameError -> String
Exception)

-- | Check if a 'String' would be a valid snapshot name.
--
-- Snapshot names consist of lowercase characters, digits, dashes @-@,
-- and underscores @_@, and must be between 1 and 64 characters long.
-- >>> isValidSnapshotName "main"
-- True
--
-- >>> isValidSnapshotName "temporary-123-test_"
-- True
--
-- >>> isValidSnapshotName "UPPER"
-- False
-- >>> isValidSnapshotName "dir/dot.exe"
-- False
-- >>> isValidSnapshotName ".."
-- False
-- >>> isValidSnapshotName "\\"
-- False
-- >>> isValidSnapshotName ""
-- False
-- >>> isValidSnapshotName (replicate 100 'a')
-- False
--
-- Snapshot names must be valid directory on both POSIX and Windows.
-- This rules out the following reserved file and directory names on Windows:
--
-- >>> isValidSnapshotName "con"
-- False
-- >>> isValidSnapshotName "prn"
-- False
-- >>> isValidSnapshotName "aux"
-- False
-- >>> isValidSnapshotName "nul"
-- False
-- >>> isValidSnapshotName "com1" -- "com2", "com3", etc.
-- False
-- >>> isValidSnapshotName "lpt1" -- "lpt2", "lpt3", etc.
-- False
--
-- See, e.g., [the VBA docs for the "Bad file name or number" error](https://learn.microsoft.com/en-us/office/vba/language/reference/user-interface-help/bad-file-name-or-number-error-52).
isValidSnapshotName :: String -> Bool
isValidSnapshotName :: String -> Bool
isValidSnapshotName String
str =
    [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [ (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isValidChar String
str
        , Int
strLength Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1
        , Int
strLength Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
64
        , String -> Bool
System.FilePath.Posix.isValid String
str
        , String -> Bool
System.FilePath.Windows.isValid String
str
        ]
  where
    strLength :: Int
    strLength :: Int
strLength = String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
str
    isValidChar :: Char -> Bool
    isValidChar :: Char -> Bool
isValidChar Char
c = (Char
'a' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'z') Bool -> Bool -> Bool
|| (Char
'0' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'9' ) Bool -> Bool -> Bool
|| Char
c Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"-_"

-- | Create snapshot name.
--
-- The given string must satsify 'isValidSnapshotName'.
--
-- Throws the following exceptions:
--
-- ['InvalidSnapshotNameError']:
--   If the given string is not a valid snapshot name.
--
toSnapshotName :: String -> SnapshotName
toSnapshotName :: String -> SnapshotName
toSnapshotName String
str
  | String -> Bool
isValidSnapshotName String
str = String -> SnapshotName
SnapshotName String
str
  | Bool
otherwise = InvalidSnapshotNameError -> SnapshotName
forall a e. Exception e => e -> a
throw (String -> InvalidSnapshotNameError
ErrSnapshotNameInvalid String
str)

snapshotsDir :: SessionRoot -> FsPath
snapshotsDir :: SessionRoot -> FsPath
snapshotsDir (SessionRoot FsPath
dir) = FsPath
dir FsPath -> FsPath -> FsPath
</> [String] -> FsPath
mkFsPath [String
"snapshots"]

-- | The directory for a specific, /named/ snapshot.
--
-- Not to be confused with the snapshot/s/ directory, which holds all named
-- snapshot directories.
newtype NamedSnapshotDir = NamedSnapshotDir { NamedSnapshotDir -> FsPath
getNamedSnapshotDir :: FsPath }

namedSnapshotDir :: SessionRoot -> SnapshotName -> NamedSnapshotDir
namedSnapshotDir :: SessionRoot -> SnapshotName -> NamedSnapshotDir
namedSnapshotDir SessionRoot
root (SnapshotName String
name) =
    FsPath -> NamedSnapshotDir
NamedSnapshotDir (SessionRoot -> FsPath
snapshotsDir SessionRoot
root FsPath -> FsPath -> FsPath
</> [String] -> FsPath
mkFsPath [String
name])

newtype SnapshotMetaDataFile = SnapshotMetaDataFile FsPath

snapshotMetaDataFile :: NamedSnapshotDir -> SnapshotMetaDataFile
snapshotMetaDataFile :: NamedSnapshotDir -> SnapshotMetaDataFile
snapshotMetaDataFile (NamedSnapshotDir FsPath
dir) =
    FsPath -> SnapshotMetaDataFile
SnapshotMetaDataFile (FsPath
dir FsPath -> FsPath -> FsPath
</> [String] -> FsPath
mkFsPath [String
"metadata"])

newtype SnapshotMetaDataChecksumFile = SnapshotMetaDataChecksumFile FsPath

snapshotMetaDataChecksumFile :: NamedSnapshotDir -> SnapshotMetaDataChecksumFile
snapshotMetaDataChecksumFile :: NamedSnapshotDir -> SnapshotMetaDataChecksumFile
snapshotMetaDataChecksumFile (NamedSnapshotDir FsPath
dir) =
    FsPath -> SnapshotMetaDataChecksumFile
SnapshotMetaDataChecksumFile (FsPath
dir FsPath -> FsPath -> FsPath
</> [String] -> FsPath
mkFsPath [String
"metadata.checksum"])

{-------------------------------------------------------------------------------
  Table paths
-------------------------------------------------------------------------------}

-- | The file name for a table's write buffer blob file
tableBlobPath :: SessionRoot -> Unique -> FsPath
tableBlobPath :: SessionRoot -> Unique -> FsPath
tableBlobPath SessionRoot
session Unique
n =
    ActiveDir -> FsPath
getActiveDir (SessionRoot -> ActiveDir
activeDir SessionRoot
session) FsPath -> FsPath -> FsPath
</> [String] -> FsPath
mkFsPath [Int -> String
forall a. Show a => a -> String
show (Unique -> Int
uniqueToInt Unique
n)] FsPath -> String -> FsPath
<.> String
"wbblobs"

{-------------------------------------------------------------------------------
  Run paths
-------------------------------------------------------------------------------}

-- | The (relative) file path locations of all the files used by the run:
--
-- The following files exist for a run:
--
-- 1. @${n}.keyops@: the sorted run of key\/operation pairs
-- 2. @${n}.blobs@:  the blob values associated with the key\/operations
-- 3. @${n}.filter@: a Bloom filter of all the keys in the run
-- 4. @${n}.index@:  an index from keys to disk page numbers
-- 5. @${n}.checksums@: a file listing the crc32c checksums of the other
--    files
--
-- The representation doesn't store the full, name, just the number @n@. Use
-- the accessor functions to get the actual names.
--
data RunFsPaths = RunFsPaths {
    -- | The directory that run files live in.
    RunFsPaths -> FsPath
runDir    :: !FsPath
  , RunFsPaths -> RunNumber
runNumber :: !RunNumber }
  deriving stock Int -> RunFsPaths -> ShowS
[RunFsPaths] -> ShowS
RunFsPaths -> String
(Int -> RunFsPaths -> ShowS)
-> (RunFsPaths -> String)
-> ([RunFsPaths] -> ShowS)
-> Show RunFsPaths
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RunFsPaths -> ShowS
showsPrec :: Int -> RunFsPaths -> ShowS
$cshow :: RunFsPaths -> String
show :: RunFsPaths -> String
$cshowList :: [RunFsPaths] -> ShowS
showList :: [RunFsPaths] -> ShowS
Show

instance NFData RunFsPaths where
  rnf :: RunFsPaths -> ()
rnf (RunFsPaths FsPath
x RunNumber
y) = FsPath -> ()
forall a. NFData a => a -> ()
rnf FsPath
x () -> () -> ()
forall a b. a -> b -> b
`seq` RunNumber -> ()
forall a. NFData a => a -> ()
rnf RunNumber
y

-- | Paths to all files associated with this run, except 'runChecksumsPath'.
pathsForRunFiles :: RunFsPaths -> ForRunFiles FsPath
pathsForRunFiles :: RunFsPaths -> ForRunFiles FsPath
pathsForRunFiles RunFsPaths
fsPaths = (String -> FsPath) -> ForRunFiles String -> ForRunFiles FsPath
forall a b. (a -> b) -> ForRunFiles a -> ForRunFiles b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (RunFsPaths -> String -> FsPath
runFilePathWithExt RunFsPaths
fsPaths) ForRunFiles String
runFileExts

runKOpsPath :: RunFsPaths -> FsPath
runKOpsPath :: RunFsPaths -> FsPath
runKOpsPath = ForKOps FsPath -> FsPath
forall a. ForKOps a -> a
unForKOps (ForKOps FsPath -> FsPath)
-> (RunFsPaths -> ForKOps FsPath) -> RunFsPaths -> FsPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ForRunFiles FsPath -> ForKOps FsPath
forall a. ForRunFiles a -> ForKOps a
forRunKOps (ForRunFiles FsPath -> ForKOps FsPath)
-> (RunFsPaths -> ForRunFiles FsPath)
-> RunFsPaths
-> ForKOps FsPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RunFsPaths -> ForRunFiles FsPath
pathsForRunFiles

runBlobPath :: RunFsPaths -> FsPath
runBlobPath :: RunFsPaths -> FsPath
runBlobPath = ForBlob FsPath -> FsPath
forall a. ForBlob a -> a
unForBlob (ForBlob FsPath -> FsPath)
-> (RunFsPaths -> ForBlob FsPath) -> RunFsPaths -> FsPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ForRunFiles FsPath -> ForBlob FsPath
forall a. ForRunFiles a -> ForBlob a
forRunBlob (ForRunFiles FsPath -> ForBlob FsPath)
-> (RunFsPaths -> ForRunFiles FsPath)
-> RunFsPaths
-> ForBlob FsPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RunFsPaths -> ForRunFiles FsPath
pathsForRunFiles

runFilterPath :: RunFsPaths -> FsPath
runFilterPath :: RunFsPaths -> FsPath
runFilterPath = ForFilter FsPath -> FsPath
forall a. ForFilter a -> a
unForFilter (ForFilter FsPath -> FsPath)
-> (RunFsPaths -> ForFilter FsPath) -> RunFsPaths -> FsPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ForRunFiles FsPath -> ForFilter FsPath
forall a. ForRunFiles a -> ForFilter a
forRunFilter (ForRunFiles FsPath -> ForFilter FsPath)
-> (RunFsPaths -> ForRunFiles FsPath)
-> RunFsPaths
-> ForFilter FsPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RunFsPaths -> ForRunFiles FsPath
pathsForRunFiles

runIndexPath :: RunFsPaths -> FsPath
runIndexPath :: RunFsPaths -> FsPath
runIndexPath = ForIndex FsPath -> FsPath
forall a. ForIndex a -> a
unForIndex (ForIndex FsPath -> FsPath)
-> (RunFsPaths -> ForIndex FsPath) -> RunFsPaths -> FsPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ForRunFiles FsPath -> ForIndex FsPath
forall a. ForRunFiles a -> ForIndex a
forRunIndex (ForRunFiles FsPath -> ForIndex FsPath)
-> (RunFsPaths -> ForRunFiles FsPath)
-> RunFsPaths
-> ForIndex FsPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RunFsPaths -> ForRunFiles FsPath
pathsForRunFiles

runChecksumsPath :: RunFsPaths -> FsPath
runChecksumsPath :: RunFsPaths -> FsPath
runChecksumsPath = (RunFsPaths -> String -> FsPath) -> String -> RunFsPaths -> FsPath
forall a b c. (a -> b -> c) -> b -> a -> c
flip RunFsPaths -> String -> FsPath
runFilePathWithExt String
"checksums"

runFilePathWithExt :: RunFsPaths -> String -> FsPath
runFilePathWithExt :: RunFsPaths -> String -> FsPath
runFilePathWithExt (RunFsPaths FsPath
dir (RunNumber Int
n)) String
ext =
    FsPath
dir FsPath -> FsPath -> FsPath
</> [String] -> FsPath
mkFsPath [Int -> String
forall a. Show a => a -> String
show Int
n] FsPath -> String -> FsPath
<.> String
ext

runFileExts :: ForRunFiles String
runFileExts :: ForRunFiles String
runFileExts = ForRunFiles {
      forRunKOps :: ForKOps String
forRunKOps   = String -> ForKOps String
forall a. a -> ForKOps a
ForKOps String
"keyops"
    , forRunBlob :: ForBlob String
forRunBlob   = String -> ForBlob String
forall a. a -> ForBlob a
ForBlob String
"blobs"
    , forRunFilter :: ForFilter String
forRunFilter = String -> ForFilter String
forall a. a -> ForFilter a
ForFilter String
"filter"
    , forRunIndex :: ForIndex String
forRunIndex  = String -> ForIndex String
forall a. a -> ForIndex a
ForIndex String
"index"
    }

{-------------------------------------------------------------------------------
  Checksums For Run Files
-------------------------------------------------------------------------------}

checksumFileNamesForRunFiles :: ForRunFiles CRC.ChecksumsFileName
checksumFileNamesForRunFiles :: ForRunFiles ChecksumsFileName
checksumFileNamesForRunFiles = (String -> ChecksumsFileName)
-> ForRunFiles String -> ForRunFiles ChecksumsFileName
forall a b. (a -> b) -> ForRunFiles a -> ForRunFiles b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString -> ChecksumsFileName
CRC.ChecksumsFileName (ByteString -> ChecksumsFileName)
-> (String -> ByteString) -> String -> ChecksumsFileName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BS.pack) ForRunFiles String
runFileExts

toChecksumsFile :: ForRunFiles CRC.CRC32C -> CRC.ChecksumsFile
toChecksumsFile :: ForRunFiles CRC32C -> ChecksumsFile
toChecksumsFile = [(ChecksumsFileName, CRC32C)] -> ChecksumsFile
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(ChecksumsFileName, CRC32C)] -> ChecksumsFile)
-> (ForRunFiles CRC32C -> [(ChecksumsFileName, CRC32C)])
-> ForRunFiles CRC32C
-> ChecksumsFile
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ForRunFiles (ChecksumsFileName, CRC32C)
-> [(ChecksumsFileName, CRC32C)]
forall a. ForRunFiles a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (ForRunFiles (ChecksumsFileName, CRC32C)
 -> [(ChecksumsFileName, CRC32C)])
-> (ForRunFiles CRC32C -> ForRunFiles (ChecksumsFileName, CRC32C))
-> ForRunFiles CRC32C
-> [(ChecksumsFileName, CRC32C)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ChecksumsFileName -> CRC32C -> (ChecksumsFileName, CRC32C))
-> ForRunFiles ChecksumsFileName
-> ForRunFiles CRC32C
-> ForRunFiles (ChecksumsFileName, CRC32C)
forall a b c.
(a -> b -> c) -> ForRunFiles a -> ForRunFiles b -> ForRunFiles c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) ForRunFiles ChecksumsFileName
checksumFileNamesForRunFiles

fromChecksumsFile :: CRC.ChecksumsFile -> Either String (ForRunFiles CRC.CRC32C)
fromChecksumsFile :: ChecksumsFile -> Either String (ForRunFiles CRC32C)
fromChecksumsFile ChecksumsFile
file = ForRunFiles ChecksumsFileName
-> (ChecksumsFileName -> Either String CRC32C)
-> Either String (ForRunFiles CRC32C)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for ForRunFiles ChecksumsFileName
checksumFileNamesForRunFiles ((ChecksumsFileName -> Either String CRC32C)
 -> Either String (ForRunFiles CRC32C))
-> (ChecksumsFileName -> Either String CRC32C)
-> Either String (ForRunFiles CRC32C)
forall a b. (a -> b) -> a -> b
$ \ChecksumsFileName
name ->
    case ChecksumsFileName -> ChecksumsFile -> Maybe CRC32C
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ChecksumsFileName
name ChecksumsFile
file of
      Just CRC32C
crc -> CRC32C -> Either String CRC32C
forall a b. b -> Either a b
Right CRC32C
crc
      Maybe CRC32C
Nothing  -> String -> Either String CRC32C
forall a b. a -> Either a b
Left (String
"key not found: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ChecksumsFileName -> String
forall a. Show a => a -> String
show ChecksumsFileName
name)

{-------------------------------------------------------------------------------
  Marker newtypes for individual elements of the ForRunFiles and the
  ForWriteBufferFiles abstractions
-------------------------------------------------------------------------------}

newtype ForKOps a = ForKOps {forall a. ForKOps a -> a
unForKOps :: a}
  deriving stock (Int -> ForKOps a -> ShowS
[ForKOps a] -> ShowS
ForKOps a -> String
(Int -> ForKOps a -> ShowS)
-> (ForKOps a -> String)
-> ([ForKOps a] -> ShowS)
-> Show (ForKOps a)
forall a. Show a => Int -> ForKOps a -> ShowS
forall a. Show a => [ForKOps a] -> ShowS
forall a. Show a => ForKOps a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> ForKOps a -> ShowS
showsPrec :: Int -> ForKOps a -> ShowS
$cshow :: forall a. Show a => ForKOps a -> String
show :: ForKOps a -> String
$cshowList :: forall a. Show a => [ForKOps a] -> ShowS
showList :: [ForKOps a] -> ShowS
Show, (forall m. Monoid m => ForKOps m -> m)
-> (forall m a. Monoid m => (a -> m) -> ForKOps a -> m)
-> (forall m a. Monoid m => (a -> m) -> ForKOps a -> m)
-> (forall a b. (a -> b -> b) -> b -> ForKOps a -> b)
-> (forall a b. (a -> b -> b) -> b -> ForKOps a -> b)
-> (forall b a. (b -> a -> b) -> b -> ForKOps a -> b)
-> (forall b a. (b -> a -> b) -> b -> ForKOps a -> b)
-> (forall a. (a -> a -> a) -> ForKOps a -> a)
-> (forall a. (a -> a -> a) -> ForKOps a -> a)
-> (forall a. ForKOps a -> [a])
-> (forall a. ForKOps a -> Bool)
-> (forall a. ForKOps a -> Int)
-> (forall a. Eq a => a -> ForKOps a -> Bool)
-> (forall a. Ord a => ForKOps a -> a)
-> (forall a. Ord a => ForKOps a -> a)
-> (forall a. Num a => ForKOps a -> a)
-> (forall a. Num a => ForKOps a -> a)
-> Foldable ForKOps
forall a. Eq a => a -> ForKOps a -> Bool
forall a. Num a => ForKOps a -> a
forall a. Ord a => ForKOps a -> a
forall m. Monoid m => ForKOps m -> m
forall a. ForKOps a -> Bool
forall a. ForKOps a -> Int
forall a. ForKOps a -> [a]
forall a. (a -> a -> a) -> ForKOps a -> a
forall m a. Monoid m => (a -> m) -> ForKOps a -> m
forall b a. (b -> a -> b) -> b -> ForKOps a -> b
forall a b. (a -> b -> b) -> b -> ForKOps 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
$cfold :: forall m. Monoid m => ForKOps m -> m
fold :: forall m. Monoid m => ForKOps m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> ForKOps a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> ForKOps a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> ForKOps a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> ForKOps a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> ForKOps a -> b
foldr :: forall a b. (a -> b -> b) -> b -> ForKOps a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> ForKOps a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> ForKOps a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> ForKOps a -> b
foldl :: forall b a. (b -> a -> b) -> b -> ForKOps a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> ForKOps a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> ForKOps a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> ForKOps a -> a
foldr1 :: forall a. (a -> a -> a) -> ForKOps a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> ForKOps a -> a
foldl1 :: forall a. (a -> a -> a) -> ForKOps a -> a
$ctoList :: forall a. ForKOps a -> [a]
toList :: forall a. ForKOps a -> [a]
$cnull :: forall a. ForKOps a -> Bool
null :: forall a. ForKOps a -> Bool
$clength :: forall a. ForKOps a -> Int
length :: forall a. ForKOps a -> Int
$celem :: forall a. Eq a => a -> ForKOps a -> Bool
elem :: forall a. Eq a => a -> ForKOps a -> Bool
$cmaximum :: forall a. Ord a => ForKOps a -> a
maximum :: forall a. Ord a => ForKOps a -> a
$cminimum :: forall a. Ord a => ForKOps a -> a
minimum :: forall a. Ord a => ForKOps a -> a
$csum :: forall a. Num a => ForKOps a -> a
sum :: forall a. Num a => ForKOps a -> a
$cproduct :: forall a. Num a => ForKOps a -> a
product :: forall a. Num a => ForKOps a -> a
Foldable, (forall a b. (a -> b) -> ForKOps a -> ForKOps b)
-> (forall a b. a -> ForKOps b -> ForKOps a) -> Functor ForKOps
forall a b. a -> ForKOps b -> ForKOps a
forall a b. (a -> b) -> ForKOps a -> ForKOps b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> ForKOps a -> ForKOps b
fmap :: forall a b. (a -> b) -> ForKOps a -> ForKOps b
$c<$ :: forall a b. a -> ForKOps b -> ForKOps a
<$ :: forall a b. a -> ForKOps b -> ForKOps a
Functor, Functor ForKOps
Foldable ForKOps
(Functor ForKOps, Foldable ForKOps) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> ForKOps a -> f (ForKOps b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    ForKOps (f a) -> f (ForKOps a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> ForKOps a -> m (ForKOps b))
-> (forall (m :: * -> *) a.
    Monad m =>
    ForKOps (m a) -> m (ForKOps a))
-> Traversable ForKOps
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 => ForKOps (m a) -> m (ForKOps a)
forall (f :: * -> *) a.
Applicative f =>
ForKOps (f a) -> f (ForKOps a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ForKOps a -> m (ForKOps b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ForKOps a -> f (ForKOps b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ForKOps a -> f (ForKOps b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ForKOps a -> f (ForKOps b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
ForKOps (f a) -> f (ForKOps a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
ForKOps (f a) -> f (ForKOps a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ForKOps a -> m (ForKOps b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ForKOps a -> m (ForKOps b)
$csequence :: forall (m :: * -> *) a. Monad m => ForKOps (m a) -> m (ForKOps a)
sequence :: forall (m :: * -> *) a. Monad m => ForKOps (m a) -> m (ForKOps a)
Traversable)

newtype ForBlob a = ForBlob {forall a. ForBlob a -> a
unForBlob :: a}
  deriving stock (Int -> ForBlob a -> ShowS
[ForBlob a] -> ShowS
ForBlob a -> String
(Int -> ForBlob a -> ShowS)
-> (ForBlob a -> String)
-> ([ForBlob a] -> ShowS)
-> Show (ForBlob a)
forall a. Show a => Int -> ForBlob a -> ShowS
forall a. Show a => [ForBlob a] -> ShowS
forall a. Show a => ForBlob a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> ForBlob a -> ShowS
showsPrec :: Int -> ForBlob a -> ShowS
$cshow :: forall a. Show a => ForBlob a -> String
show :: ForBlob a -> String
$cshowList :: forall a. Show a => [ForBlob a] -> ShowS
showList :: [ForBlob a] -> ShowS
Show, (forall m. Monoid m => ForBlob m -> m)
-> (forall m a. Monoid m => (a -> m) -> ForBlob a -> m)
-> (forall m a. Monoid m => (a -> m) -> ForBlob a -> m)
-> (forall a b. (a -> b -> b) -> b -> ForBlob a -> b)
-> (forall a b. (a -> b -> b) -> b -> ForBlob a -> b)
-> (forall b a. (b -> a -> b) -> b -> ForBlob a -> b)
-> (forall b a. (b -> a -> b) -> b -> ForBlob a -> b)
-> (forall a. (a -> a -> a) -> ForBlob a -> a)
-> (forall a. (a -> a -> a) -> ForBlob a -> a)
-> (forall a. ForBlob a -> [a])
-> (forall a. ForBlob a -> Bool)
-> (forall a. ForBlob a -> Int)
-> (forall a. Eq a => a -> ForBlob a -> Bool)
-> (forall a. Ord a => ForBlob a -> a)
-> (forall a. Ord a => ForBlob a -> a)
-> (forall a. Num a => ForBlob a -> a)
-> (forall a. Num a => ForBlob a -> a)
-> Foldable ForBlob
forall a. Eq a => a -> ForBlob a -> Bool
forall a. Num a => ForBlob a -> a
forall a. Ord a => ForBlob a -> a
forall m. Monoid m => ForBlob m -> m
forall a. ForBlob a -> Bool
forall a. ForBlob a -> Int
forall a. ForBlob a -> [a]
forall a. (a -> a -> a) -> ForBlob a -> a
forall m a. Monoid m => (a -> m) -> ForBlob a -> m
forall b a. (b -> a -> b) -> b -> ForBlob a -> b
forall a b. (a -> b -> b) -> b -> ForBlob 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
$cfold :: forall m. Monoid m => ForBlob m -> m
fold :: forall m. Monoid m => ForBlob m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> ForBlob a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> ForBlob a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> ForBlob a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> ForBlob a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> ForBlob a -> b
foldr :: forall a b. (a -> b -> b) -> b -> ForBlob a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> ForBlob a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> ForBlob a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> ForBlob a -> b
foldl :: forall b a. (b -> a -> b) -> b -> ForBlob a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> ForBlob a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> ForBlob a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> ForBlob a -> a
foldr1 :: forall a. (a -> a -> a) -> ForBlob a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> ForBlob a -> a
foldl1 :: forall a. (a -> a -> a) -> ForBlob a -> a
$ctoList :: forall a. ForBlob a -> [a]
toList :: forall a. ForBlob a -> [a]
$cnull :: forall a. ForBlob a -> Bool
null :: forall a. ForBlob a -> Bool
$clength :: forall a. ForBlob a -> Int
length :: forall a. ForBlob a -> Int
$celem :: forall a. Eq a => a -> ForBlob a -> Bool
elem :: forall a. Eq a => a -> ForBlob a -> Bool
$cmaximum :: forall a. Ord a => ForBlob a -> a
maximum :: forall a. Ord a => ForBlob a -> a
$cminimum :: forall a. Ord a => ForBlob a -> a
minimum :: forall a. Ord a => ForBlob a -> a
$csum :: forall a. Num a => ForBlob a -> a
sum :: forall a. Num a => ForBlob a -> a
$cproduct :: forall a. Num a => ForBlob a -> a
product :: forall a. Num a => ForBlob a -> a
Foldable, (forall a b. (a -> b) -> ForBlob a -> ForBlob b)
-> (forall a b. a -> ForBlob b -> ForBlob a) -> Functor ForBlob
forall a b. a -> ForBlob b -> ForBlob a
forall a b. (a -> b) -> ForBlob a -> ForBlob b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> ForBlob a -> ForBlob b
fmap :: forall a b. (a -> b) -> ForBlob a -> ForBlob b
$c<$ :: forall a b. a -> ForBlob b -> ForBlob a
<$ :: forall a b. a -> ForBlob b -> ForBlob a
Functor, Functor ForBlob
Foldable ForBlob
(Functor ForBlob, Foldable ForBlob) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> ForBlob a -> f (ForBlob b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    ForBlob (f a) -> f (ForBlob a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> ForBlob a -> m (ForBlob b))
-> (forall (m :: * -> *) a.
    Monad m =>
    ForBlob (m a) -> m (ForBlob a))
-> Traversable ForBlob
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 => ForBlob (m a) -> m (ForBlob a)
forall (f :: * -> *) a.
Applicative f =>
ForBlob (f a) -> f (ForBlob a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ForBlob a -> m (ForBlob b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ForBlob a -> f (ForBlob b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ForBlob a -> f (ForBlob b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ForBlob a -> f (ForBlob b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
ForBlob (f a) -> f (ForBlob a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
ForBlob (f a) -> f (ForBlob a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ForBlob a -> m (ForBlob b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ForBlob a -> m (ForBlob b)
$csequence :: forall (m :: * -> *) a. Monad m => ForBlob (m a) -> m (ForBlob a)
sequence :: forall (m :: * -> *) a. Monad m => ForBlob (m a) -> m (ForBlob a)
Traversable)

newtype ForFilter a = ForFilter {forall a. ForFilter a -> a
unForFilter :: a}
  deriving stock (Int -> ForFilter a -> ShowS
[ForFilter a] -> ShowS
ForFilter a -> String
(Int -> ForFilter a -> ShowS)
-> (ForFilter a -> String)
-> ([ForFilter a] -> ShowS)
-> Show (ForFilter a)
forall a. Show a => Int -> ForFilter a -> ShowS
forall a. Show a => [ForFilter a] -> ShowS
forall a. Show a => ForFilter a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> ForFilter a -> ShowS
showsPrec :: Int -> ForFilter a -> ShowS
$cshow :: forall a. Show a => ForFilter a -> String
show :: ForFilter a -> String
$cshowList :: forall a. Show a => [ForFilter a] -> ShowS
showList :: [ForFilter a] -> ShowS
Show, (forall m. Monoid m => ForFilter m -> m)
-> (forall m a. Monoid m => (a -> m) -> ForFilter a -> m)
-> (forall m a. Monoid m => (a -> m) -> ForFilter a -> m)
-> (forall a b. (a -> b -> b) -> b -> ForFilter a -> b)
-> (forall a b. (a -> b -> b) -> b -> ForFilter a -> b)
-> (forall b a. (b -> a -> b) -> b -> ForFilter a -> b)
-> (forall b a. (b -> a -> b) -> b -> ForFilter a -> b)
-> (forall a. (a -> a -> a) -> ForFilter a -> a)
-> (forall a. (a -> a -> a) -> ForFilter a -> a)
-> (forall a. ForFilter a -> [a])
-> (forall a. ForFilter a -> Bool)
-> (forall a. ForFilter a -> Int)
-> (forall a. Eq a => a -> ForFilter a -> Bool)
-> (forall a. Ord a => ForFilter a -> a)
-> (forall a. Ord a => ForFilter a -> a)
-> (forall a. Num a => ForFilter a -> a)
-> (forall a. Num a => ForFilter a -> a)
-> Foldable ForFilter
forall a. Eq a => a -> ForFilter a -> Bool
forall a. Num a => ForFilter a -> a
forall a. Ord a => ForFilter a -> a
forall m. Monoid m => ForFilter m -> m
forall a. ForFilter a -> Bool
forall a. ForFilter a -> Int
forall a. ForFilter a -> [a]
forall a. (a -> a -> a) -> ForFilter a -> a
forall m a. Monoid m => (a -> m) -> ForFilter a -> m
forall b a. (b -> a -> b) -> b -> ForFilter a -> b
forall a b. (a -> b -> b) -> b -> ForFilter 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
$cfold :: forall m. Monoid m => ForFilter m -> m
fold :: forall m. Monoid m => ForFilter m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> ForFilter a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> ForFilter a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> ForFilter a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> ForFilter a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> ForFilter a -> b
foldr :: forall a b. (a -> b -> b) -> b -> ForFilter a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> ForFilter a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> ForFilter a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> ForFilter a -> b
foldl :: forall b a. (b -> a -> b) -> b -> ForFilter a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> ForFilter a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> ForFilter a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> ForFilter a -> a
foldr1 :: forall a. (a -> a -> a) -> ForFilter a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> ForFilter a -> a
foldl1 :: forall a. (a -> a -> a) -> ForFilter a -> a
$ctoList :: forall a. ForFilter a -> [a]
toList :: forall a. ForFilter a -> [a]
$cnull :: forall a. ForFilter a -> Bool
null :: forall a. ForFilter a -> Bool
$clength :: forall a. ForFilter a -> Int
length :: forall a. ForFilter a -> Int
$celem :: forall a. Eq a => a -> ForFilter a -> Bool
elem :: forall a. Eq a => a -> ForFilter a -> Bool
$cmaximum :: forall a. Ord a => ForFilter a -> a
maximum :: forall a. Ord a => ForFilter a -> a
$cminimum :: forall a. Ord a => ForFilter a -> a
minimum :: forall a. Ord a => ForFilter a -> a
$csum :: forall a. Num a => ForFilter a -> a
sum :: forall a. Num a => ForFilter a -> a
$cproduct :: forall a. Num a => ForFilter a -> a
product :: forall a. Num a => ForFilter a -> a
Foldable, (forall a b. (a -> b) -> ForFilter a -> ForFilter b)
-> (forall a b. a -> ForFilter b -> ForFilter a)
-> Functor ForFilter
forall a b. a -> ForFilter b -> ForFilter a
forall a b. (a -> b) -> ForFilter a -> ForFilter b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> ForFilter a -> ForFilter b
fmap :: forall a b. (a -> b) -> ForFilter a -> ForFilter b
$c<$ :: forall a b. a -> ForFilter b -> ForFilter a
<$ :: forall a b. a -> ForFilter b -> ForFilter a
Functor, Functor ForFilter
Foldable ForFilter
(Functor ForFilter, Foldable ForFilter) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> ForFilter a -> f (ForFilter b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    ForFilter (f a) -> f (ForFilter a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> ForFilter a -> m (ForFilter b))
-> (forall (m :: * -> *) a.
    Monad m =>
    ForFilter (m a) -> m (ForFilter a))
-> Traversable ForFilter
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 =>
ForFilter (m a) -> m (ForFilter a)
forall (f :: * -> *) a.
Applicative f =>
ForFilter (f a) -> f (ForFilter a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ForFilter a -> m (ForFilter b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ForFilter a -> f (ForFilter b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ForFilter a -> f (ForFilter b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ForFilter a -> f (ForFilter b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
ForFilter (f a) -> f (ForFilter a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
ForFilter (f a) -> f (ForFilter a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ForFilter a -> m (ForFilter b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ForFilter a -> m (ForFilter b)
$csequence :: forall (m :: * -> *) a.
Monad m =>
ForFilter (m a) -> m (ForFilter a)
sequence :: forall (m :: * -> *) a.
Monad m =>
ForFilter (m a) -> m (ForFilter a)
Traversable)

newtype ForIndex a = ForIndex {forall a. ForIndex a -> a
unForIndex :: a}
  deriving stock (Int -> ForIndex a -> ShowS
[ForIndex a] -> ShowS
ForIndex a -> String
(Int -> ForIndex a -> ShowS)
-> (ForIndex a -> String)
-> ([ForIndex a] -> ShowS)
-> Show (ForIndex a)
forall a. Show a => Int -> ForIndex a -> ShowS
forall a. Show a => [ForIndex a] -> ShowS
forall a. Show a => ForIndex a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> ForIndex a -> ShowS
showsPrec :: Int -> ForIndex a -> ShowS
$cshow :: forall a. Show a => ForIndex a -> String
show :: ForIndex a -> String
$cshowList :: forall a. Show a => [ForIndex a] -> ShowS
showList :: [ForIndex a] -> ShowS
Show, (forall m. Monoid m => ForIndex m -> m)
-> (forall m a. Monoid m => (a -> m) -> ForIndex a -> m)
-> (forall m a. Monoid m => (a -> m) -> ForIndex a -> m)
-> (forall a b. (a -> b -> b) -> b -> ForIndex a -> b)
-> (forall a b. (a -> b -> b) -> b -> ForIndex a -> b)
-> (forall b a. (b -> a -> b) -> b -> ForIndex a -> b)
-> (forall b a. (b -> a -> b) -> b -> ForIndex a -> b)
-> (forall a. (a -> a -> a) -> ForIndex a -> a)
-> (forall a. (a -> a -> a) -> ForIndex a -> a)
-> (forall a. ForIndex a -> [a])
-> (forall a. ForIndex a -> Bool)
-> (forall a. ForIndex a -> Int)
-> (forall a. Eq a => a -> ForIndex a -> Bool)
-> (forall a. Ord a => ForIndex a -> a)
-> (forall a. Ord a => ForIndex a -> a)
-> (forall a. Num a => ForIndex a -> a)
-> (forall a. Num a => ForIndex a -> a)
-> Foldable ForIndex
forall a. Eq a => a -> ForIndex a -> Bool
forall a. Num a => ForIndex a -> a
forall a. Ord a => ForIndex a -> a
forall m. Monoid m => ForIndex m -> m
forall a. ForIndex a -> Bool
forall a. ForIndex a -> Int
forall a. ForIndex a -> [a]
forall a. (a -> a -> a) -> ForIndex a -> a
forall m a. Monoid m => (a -> m) -> ForIndex a -> m
forall b a. (b -> a -> b) -> b -> ForIndex a -> b
forall a b. (a -> b -> b) -> b -> ForIndex 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
$cfold :: forall m. Monoid m => ForIndex m -> m
fold :: forall m. Monoid m => ForIndex m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> ForIndex a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> ForIndex a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> ForIndex a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> ForIndex a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> ForIndex a -> b
foldr :: forall a b. (a -> b -> b) -> b -> ForIndex a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> ForIndex a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> ForIndex a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> ForIndex a -> b
foldl :: forall b a. (b -> a -> b) -> b -> ForIndex a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> ForIndex a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> ForIndex a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> ForIndex a -> a
foldr1 :: forall a. (a -> a -> a) -> ForIndex a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> ForIndex a -> a
foldl1 :: forall a. (a -> a -> a) -> ForIndex a -> a
$ctoList :: forall a. ForIndex a -> [a]
toList :: forall a. ForIndex a -> [a]
$cnull :: forall a. ForIndex a -> Bool
null :: forall a. ForIndex a -> Bool
$clength :: forall a. ForIndex a -> Int
length :: forall a. ForIndex a -> Int
$celem :: forall a. Eq a => a -> ForIndex a -> Bool
elem :: forall a. Eq a => a -> ForIndex a -> Bool
$cmaximum :: forall a. Ord a => ForIndex a -> a
maximum :: forall a. Ord a => ForIndex a -> a
$cminimum :: forall a. Ord a => ForIndex a -> a
minimum :: forall a. Ord a => ForIndex a -> a
$csum :: forall a. Num a => ForIndex a -> a
sum :: forall a. Num a => ForIndex a -> a
$cproduct :: forall a. Num a => ForIndex a -> a
product :: forall a. Num a => ForIndex a -> a
Foldable, (forall a b. (a -> b) -> ForIndex a -> ForIndex b)
-> (forall a b. a -> ForIndex b -> ForIndex a) -> Functor ForIndex
forall a b. a -> ForIndex b -> ForIndex a
forall a b. (a -> b) -> ForIndex a -> ForIndex b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> ForIndex a -> ForIndex b
fmap :: forall a b. (a -> b) -> ForIndex a -> ForIndex b
$c<$ :: forall a b. a -> ForIndex b -> ForIndex a
<$ :: forall a b. a -> ForIndex b -> ForIndex a
Functor, Functor ForIndex
Foldable ForIndex
(Functor ForIndex, Foldable ForIndex) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> ForIndex a -> f (ForIndex b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    ForIndex (f a) -> f (ForIndex a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> ForIndex a -> m (ForIndex b))
-> (forall (m :: * -> *) a.
    Monad m =>
    ForIndex (m a) -> m (ForIndex a))
-> Traversable ForIndex
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 => ForIndex (m a) -> m (ForIndex a)
forall (f :: * -> *) a.
Applicative f =>
ForIndex (f a) -> f (ForIndex a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ForIndex a -> m (ForIndex b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ForIndex a -> f (ForIndex b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ForIndex a -> f (ForIndex b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ForIndex a -> f (ForIndex b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
ForIndex (f a) -> f (ForIndex a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
ForIndex (f a) -> f (ForIndex a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ForIndex a -> m (ForIndex b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ForIndex a -> m (ForIndex b)
$csequence :: forall (m :: * -> *) a. Monad m => ForIndex (m a) -> m (ForIndex a)
sequence :: forall (m :: * -> *) a. Monad m => ForIndex (m a) -> m (ForIndex a)
Traversable)

{-------------------------------------------------------------------------------
  ForRunFiles abstraction
-------------------------------------------------------------------------------}

-- | Stores someting for each run file (except the checksums file), allowing to
-- easily do something for all of them without mixing them up.
data ForRunFiles a = ForRunFiles {
      forall a. ForRunFiles a -> ForKOps a
forRunKOps   :: !(ForKOps a)
    , forall a. ForRunFiles a -> ForBlob a
forRunBlob   :: !(ForBlob a)
    , forall a. ForRunFiles a -> ForFilter a
forRunFilter :: !(ForFilter a)
    , forall a. ForRunFiles a -> ForIndex a
forRunIndex  :: !(ForIndex a)
    }
  deriving stock (Int -> ForRunFiles a -> ShowS
[ForRunFiles a] -> ShowS
ForRunFiles a -> String
(Int -> ForRunFiles a -> ShowS)
-> (ForRunFiles a -> String)
-> ([ForRunFiles a] -> ShowS)
-> Show (ForRunFiles a)
forall a. Show a => Int -> ForRunFiles a -> ShowS
forall a. Show a => [ForRunFiles a] -> ShowS
forall a. Show a => ForRunFiles a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> ForRunFiles a -> ShowS
showsPrec :: Int -> ForRunFiles a -> ShowS
$cshow :: forall a. Show a => ForRunFiles a -> String
show :: ForRunFiles a -> String
$cshowList :: forall a. Show a => [ForRunFiles a] -> ShowS
showList :: [ForRunFiles a] -> ShowS
Show, (forall m. Monoid m => ForRunFiles m -> m)
-> (forall m a. Monoid m => (a -> m) -> ForRunFiles a -> m)
-> (forall m a. Monoid m => (a -> m) -> ForRunFiles a -> m)
-> (forall a b. (a -> b -> b) -> b -> ForRunFiles a -> b)
-> (forall a b. (a -> b -> b) -> b -> ForRunFiles a -> b)
-> (forall b a. (b -> a -> b) -> b -> ForRunFiles a -> b)
-> (forall b a. (b -> a -> b) -> b -> ForRunFiles a -> b)
-> (forall a. (a -> a -> a) -> ForRunFiles a -> a)
-> (forall a. (a -> a -> a) -> ForRunFiles a -> a)
-> (forall a. ForRunFiles a -> [a])
-> (forall a. ForRunFiles a -> Bool)
-> (forall a. ForRunFiles a -> Int)
-> (forall a. Eq a => a -> ForRunFiles a -> Bool)
-> (forall a. Ord a => ForRunFiles a -> a)
-> (forall a. Ord a => ForRunFiles a -> a)
-> (forall a. Num a => ForRunFiles a -> a)
-> (forall a. Num a => ForRunFiles a -> a)
-> Foldable ForRunFiles
forall a. Eq a => a -> ForRunFiles a -> Bool
forall a. Num a => ForRunFiles a -> a
forall a. Ord a => ForRunFiles a -> a
forall m. Monoid m => ForRunFiles m -> m
forall a. ForRunFiles a -> Bool
forall a. ForRunFiles a -> Int
forall a. ForRunFiles a -> [a]
forall a. (a -> a -> a) -> ForRunFiles a -> a
forall m a. Monoid m => (a -> m) -> ForRunFiles a -> m
forall b a. (b -> a -> b) -> b -> ForRunFiles a -> b
forall a b. (a -> b -> b) -> b -> ForRunFiles 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
$cfold :: forall m. Monoid m => ForRunFiles m -> m
fold :: forall m. Monoid m => ForRunFiles m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> ForRunFiles a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> ForRunFiles a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> ForRunFiles a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> ForRunFiles a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> ForRunFiles a -> b
foldr :: forall a b. (a -> b -> b) -> b -> ForRunFiles a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> ForRunFiles a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> ForRunFiles a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> ForRunFiles a -> b
foldl :: forall b a. (b -> a -> b) -> b -> ForRunFiles a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> ForRunFiles a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> ForRunFiles a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> ForRunFiles a -> a
foldr1 :: forall a. (a -> a -> a) -> ForRunFiles a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> ForRunFiles a -> a
foldl1 :: forall a. (a -> a -> a) -> ForRunFiles a -> a
$ctoList :: forall a. ForRunFiles a -> [a]
toList :: forall a. ForRunFiles a -> [a]
$cnull :: forall a. ForRunFiles a -> Bool
null :: forall a. ForRunFiles a -> Bool
$clength :: forall a. ForRunFiles a -> Int
length :: forall a. ForRunFiles a -> Int
$celem :: forall a. Eq a => a -> ForRunFiles a -> Bool
elem :: forall a. Eq a => a -> ForRunFiles a -> Bool
$cmaximum :: forall a. Ord a => ForRunFiles a -> a
maximum :: forall a. Ord a => ForRunFiles a -> a
$cminimum :: forall a. Ord a => ForRunFiles a -> a
minimum :: forall a. Ord a => ForRunFiles a -> a
$csum :: forall a. Num a => ForRunFiles a -> a
sum :: forall a. Num a => ForRunFiles a -> a
$cproduct :: forall a. Num a => ForRunFiles a -> a
product :: forall a. Num a => ForRunFiles a -> a
Foldable, (forall a b. (a -> b) -> ForRunFiles a -> ForRunFiles b)
-> (forall a b. a -> ForRunFiles b -> ForRunFiles a)
-> Functor ForRunFiles
forall a b. a -> ForRunFiles b -> ForRunFiles a
forall a b. (a -> b) -> ForRunFiles a -> ForRunFiles b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> ForRunFiles a -> ForRunFiles b
fmap :: forall a b. (a -> b) -> ForRunFiles a -> ForRunFiles b
$c<$ :: forall a b. a -> ForRunFiles b -> ForRunFiles a
<$ :: forall a b. a -> ForRunFiles b -> ForRunFiles a
Functor, Functor ForRunFiles
Foldable ForRunFiles
(Functor ForRunFiles, Foldable ForRunFiles) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> ForRunFiles a -> f (ForRunFiles b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    ForRunFiles (f a) -> f (ForRunFiles a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> ForRunFiles a -> m (ForRunFiles b))
-> (forall (m :: * -> *) a.
    Monad m =>
    ForRunFiles (m a) -> m (ForRunFiles a))
-> Traversable ForRunFiles
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 =>
ForRunFiles (m a) -> m (ForRunFiles a)
forall (f :: * -> *) a.
Applicative f =>
ForRunFiles (f a) -> f (ForRunFiles a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ForRunFiles a -> m (ForRunFiles b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ForRunFiles a -> f (ForRunFiles b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ForRunFiles a -> f (ForRunFiles b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ForRunFiles a -> f (ForRunFiles b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
ForRunFiles (f a) -> f (ForRunFiles a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
ForRunFiles (f a) -> f (ForRunFiles a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ForRunFiles a -> m (ForRunFiles b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ForRunFiles a -> m (ForRunFiles b)
$csequence :: forall (m :: * -> *) a.
Monad m =>
ForRunFiles (m a) -> m (ForRunFiles a)
sequence :: forall (m :: * -> *) a.
Monad m =>
ForRunFiles (m a) -> m (ForRunFiles a)
Traversable)

forRunKOpsRaw :: ForRunFiles a -> a
forRunKOpsRaw :: forall a. ForRunFiles a -> a
forRunKOpsRaw = ForKOps a -> a
forall a. ForKOps a -> a
unForKOps (ForKOps a -> a)
-> (ForRunFiles a -> ForKOps a) -> ForRunFiles a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ForRunFiles a -> ForKOps a
forall a. ForRunFiles a -> ForKOps a
forRunKOps

forRunBlobRaw :: ForRunFiles a -> a
forRunBlobRaw :: forall a. ForRunFiles a -> a
forRunBlobRaw = ForBlob a -> a
forall a. ForBlob a -> a
unForBlob (ForBlob a -> a)
-> (ForRunFiles a -> ForBlob a) -> ForRunFiles a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ForRunFiles a -> ForBlob a
forall a. ForRunFiles a -> ForBlob a
forRunBlob

forRunFilterRaw :: ForRunFiles a -> a
forRunFilterRaw :: forall a. ForRunFiles a -> a
forRunFilterRaw = ForFilter a -> a
forall a. ForFilter a -> a
unForFilter (ForFilter a -> a)
-> (ForRunFiles a -> ForFilter a) -> ForRunFiles a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ForRunFiles a -> ForFilter a
forall a. ForRunFiles a -> ForFilter a
forRunFilter

forRunIndexRaw :: ForRunFiles a -> a
forRunIndexRaw :: forall a. ForRunFiles a -> a
forRunIndexRaw = ForIndex a -> a
forall a. ForIndex a -> a
unForIndex (ForIndex a -> a)
-> (ForRunFiles a -> ForIndex a) -> ForRunFiles a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ForRunFiles a -> ForIndex a
forall a. ForRunFiles a -> ForIndex a
forRunIndex

instance Applicative ForRunFiles where
  pure :: forall a. a -> ForRunFiles a
pure a
x = ForKOps a
-> ForBlob a -> ForFilter a -> ForIndex a -> ForRunFiles a
forall a.
ForKOps a
-> ForBlob a -> ForFilter a -> ForIndex a -> ForRunFiles a
ForRunFiles (a -> ForKOps a
forall a. a -> ForKOps a
ForKOps a
x) (a -> ForBlob a
forall a. a -> ForBlob a
ForBlob a
x) (a -> ForFilter a
forall a. a -> ForFilter a
ForFilter a
x) (a -> ForIndex a
forall a. a -> ForIndex a
ForIndex a
x)
  ForRunFiles (ForKOps a -> b
f1) (ForBlob a -> b
f2) (ForFilter a -> b
f3) (ForIndex a -> b
f4) <*> :: forall a b. ForRunFiles (a -> b) -> ForRunFiles a -> ForRunFiles b
<*> ForRunFiles (ForKOps a
x1) (ForBlob a
x2) (ForFilter a
x3) (ForIndex a
x4) =
    ForKOps b
-> ForBlob b -> ForFilter b -> ForIndex b -> ForRunFiles b
forall a.
ForKOps a
-> ForBlob a -> ForFilter a -> ForIndex a -> ForRunFiles a
ForRunFiles (b -> ForKOps b
forall a. a -> ForKOps a
ForKOps (b -> ForKOps b) -> b -> ForKOps b
forall a b. (a -> b) -> a -> b
$ a -> b
f1 a
x1) (b -> ForBlob b
forall a. a -> ForBlob a
ForBlob (b -> ForBlob b) -> b -> ForBlob b
forall a b. (a -> b) -> a -> b
$ a -> b
f2 a
x2) (b -> ForFilter b
forall a. a -> ForFilter a
ForFilter (b -> ForFilter b) -> b -> ForFilter b
forall a b. (a -> b) -> a -> b
$ a -> b
f3 a
x3) (b -> ForIndex b
forall a. a -> ForIndex a
ForIndex (b -> ForIndex b) -> b -> ForIndex b
forall a b. (a -> b) -> a -> b
$ a -> b
f4 a
x4)

{-------------------------------------------------------------------------------
  WriteBuffer paths
-------------------------------------------------------------------------------}

newtype WriteBufferFsPaths = WrapRunFsPaths RunFsPaths

pattern WriteBufferFsPaths :: FsPath -> RunNumber -> WriteBufferFsPaths
pattern $mWriteBufferFsPaths :: forall {r}.
WriteBufferFsPaths
-> (FsPath -> RunNumber -> r) -> ((# #) -> r) -> r
$bWriteBufferFsPaths :: FsPath -> RunNumber -> WriteBufferFsPaths
WriteBufferFsPaths {WriteBufferFsPaths -> FsPath
writeBufferDir, WriteBufferFsPaths -> RunNumber
writeBufferNumber} = WrapRunFsPaths (RunFsPaths writeBufferDir writeBufferNumber)

{-# COMPLETE WriteBufferFsPaths #-}

writeBufferKOpsExt :: String
writeBufferKOpsExt :: String
writeBufferKOpsExt = ForKOps String -> String
forall a. ForKOps a -> a
unForKOps (ForKOps String -> String)
-> (ForRunFiles String -> ForKOps String)
-> ForRunFiles String
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ForRunFiles String -> ForKOps String
forall a. ForRunFiles a -> ForKOps a
forRunKOps (ForRunFiles String -> String) -> ForRunFiles String -> String
forall a b. (a -> b) -> a -> b
$ ForRunFiles String
runFileExts

writeBufferBlobExt :: String
writeBufferBlobExt :: String
writeBufferBlobExt = ForBlob String -> String
forall a. ForBlob a -> a
unForBlob (ForBlob String -> String)
-> (ForRunFiles String -> ForBlob String)
-> ForRunFiles String
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ForRunFiles String -> ForBlob String
forall a. ForRunFiles a -> ForBlob a
forRunBlob (ForRunFiles String -> String) -> ForRunFiles String -> String
forall a b. (a -> b) -> a -> b
$ ForRunFiles String
runFileExts

writeBufferKOpsPath :: WriteBufferFsPaths -> FsPath
writeBufferKOpsPath :: WriteBufferFsPaths -> FsPath
writeBufferKOpsPath = (WriteBufferFsPaths -> String -> FsPath)
-> String -> WriteBufferFsPaths -> FsPath
forall a b c. (a -> b -> c) -> b -> a -> c
flip WriteBufferFsPaths -> String -> FsPath
writeBufferFilePathWithExt String
writeBufferKOpsExt

writeBufferBlobPath :: WriteBufferFsPaths -> FsPath
writeBufferBlobPath :: WriteBufferFsPaths -> FsPath
writeBufferBlobPath = (WriteBufferFsPaths -> String -> FsPath)
-> String -> WriteBufferFsPaths -> FsPath
forall a b c. (a -> b -> c) -> b -> a -> c
flip WriteBufferFsPaths -> String -> FsPath
writeBufferFilePathWithExt String
writeBufferBlobExt

writeBufferChecksumsPath :: WriteBufferFsPaths -> FsPath
writeBufferChecksumsPath :: WriteBufferFsPaths -> FsPath
writeBufferChecksumsPath = (WriteBufferFsPaths -> String -> FsPath)
-> String -> WriteBufferFsPaths -> FsPath
forall a b c. (a -> b -> c) -> b -> a -> c
flip WriteBufferFsPaths -> String -> FsPath
writeBufferFilePathWithExt String
"checksums"

writeBufferFilePathWithExt :: WriteBufferFsPaths -> String -> FsPath
writeBufferFilePathWithExt :: WriteBufferFsPaths -> String -> FsPath
writeBufferFilePathWithExt (WriteBufferFsPaths FsPath
dir (RunNumber Int
n)) String
ext =
    FsPath
dir FsPath -> FsPath -> FsPath
</> [String] -> FsPath
mkFsPath [Int -> String
forall a. Show a => a -> String
show Int
n] FsPath -> String -> FsPath
<.> String
ext


{-------------------------------------------------------------------------------
  Checksums For Run Files
-------------------------------------------------------------------------------}

toChecksumsFileForWriteBufferFiles :: (ForKOps CRC.CRC32C, ForBlob CRC.CRC32C) -> CRC.ChecksumsFile
toChecksumsFileForWriteBufferFiles :: (ForKOps CRC32C, ForBlob CRC32C) -> ChecksumsFile
toChecksumsFileForWriteBufferFiles (ForKOps CRC32C
kOpsChecksum, ForBlob CRC32C
blobChecksum) =
  [(ChecksumsFileName, CRC32C)] -> ChecksumsFile
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
    [ (String -> ChecksumsFileName
toChecksumsFileName String
writeBufferKOpsExt, CRC32C
kOpsChecksum)
    , (String -> ChecksumsFileName
toChecksumsFileName String
writeBufferBlobExt, CRC32C
blobChecksum)
    ]
  where
    toChecksumsFileName :: String -> ChecksumsFileName
toChecksumsFileName = ByteString -> ChecksumsFileName
CRC.ChecksumsFileName (ByteString -> ChecksumsFileName)
-> (String -> ByteString) -> String -> ChecksumsFileName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BS.pack

fromChecksumsFileForWriteBufferFiles :: CRC.ChecksumsFile -> Either String (ForKOps CRC.CRC32C, ForBlob CRC.CRC32C)
fromChecksumsFileForWriteBufferFiles :: ChecksumsFile -> Either String (ForKOps CRC32C, ForBlob CRC32C)
fromChecksumsFileForWriteBufferFiles ChecksumsFile
file = do
  (,) (ForKOps CRC32C
 -> ForBlob CRC32C -> (ForKOps CRC32C, ForBlob CRC32C))
-> Either String (ForKOps CRC32C)
-> Either
     String (ForBlob CRC32C -> (ForKOps CRC32C, ForBlob CRC32C))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (CRC32C -> ForKOps CRC32C
forall a. a -> ForKOps a
ForKOps (CRC32C -> ForKOps CRC32C)
-> Either String CRC32C -> Either String (ForKOps CRC32C)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Either String CRC32C
fromChecksumFile String
writeBufferKOpsExt) Either String (ForBlob CRC32C -> (ForKOps CRC32C, ForBlob CRC32C))
-> Either String (ForBlob CRC32C)
-> Either String (ForKOps CRC32C, ForBlob CRC32C)
forall a b.
Either String (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (CRC32C -> ForBlob CRC32C
forall a. a -> ForBlob a
ForBlob (CRC32C -> ForBlob CRC32C)
-> Either String CRC32C -> Either String (ForBlob CRC32C)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Either String CRC32C
fromChecksumFile String
writeBufferBlobExt)
  where
    fromChecksumFile :: String -> Either String CRC32C
fromChecksumFile String
key =
      Either String CRC32C
-> (CRC32C -> Either String CRC32C)
-> Maybe CRC32C
-> Either String CRC32C
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Either String CRC32C
forall a b. a -> Either a b
Left (String -> Either String CRC32C) -> String -> Either String CRC32C
forall a b. (a -> b) -> a -> b
$ String
"key not found: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
key) CRC32C -> Either String CRC32C
forall a b. b -> Either a b
Right (Maybe CRC32C -> Either String CRC32C)
-> Maybe CRC32C -> Either String CRC32C
forall a b. (a -> b) -> a -> b
$
        ChecksumsFileName -> ChecksumsFile -> Maybe CRC32C
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (ByteString -> ChecksumsFileName
CRC.ChecksumsFileName (ByteString -> ChecksumsFileName)
-> (String -> ByteString) -> String -> ChecksumsFileName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
forall a. IsString a => String -> a
fromString (String -> ChecksumsFileName) -> String -> ChecksumsFileName
forall a b. (a -> b) -> a -> b
$ String
key) ChecksumsFile
file