    {-# LANGUAGE ScopedTypeVariables, RecordWildCards, FlexibleInstances #-}
    {-# LANGUAGE BangPatterns, GeneralizedNewtypeDeriving #-}
    {-
    This module stores the meta-data so its very important its always accurate
    We can't rely on getting any exceptions or termination at the end, so we'd better write out a journal
    We store a series of records, and if they contain twice as many records as needed, we compact
    -}

    module Development.Shake.Internal.Core.Storage(
        usingStorage
        ) where

    import General.Chunks
    import General.Cleanup
    import General.Binary
    import General.Intern
    import Development.Shake.Internal.Options
    import Development.Shake.Internal.Errors
    import General.Timing
    import General.FileLock
    import qualified General.Ids as Ids

    import Control.Exception.Extra
    import Control.Monad.Extra
    import Data.Monoid
    import Data.Either.Extra
    import Data.Time
    import Data.Char
    import Data.Word
    import System.Info
    import Development.Shake.Classes
    import Numeric
    import General.Extra
    import Data.List.Extra
    import Data.Maybe
    import System.FilePath
    import qualified Data.ByteString.UTF8 as UTF8
    import qualified Data.HashMap.Strict as Map

    import qualified Data.ByteString.Char8 as BS
    import qualified Data.ByteString as BS8
    import Prelude

    -- Increment every time the on-disk format/semantics change,
    -- @x@ is for the users version number
    databaseVersion :: String -> String
    -- THINGS I WANT TO DO ON THE NEXT CHANGE
    -- * Change filepaths to store a 1 byte prefix saying 8bit ASCII or UTF8
    -- * Duration and Time should be stored as number of 1/10000th seconds Int32
    databaseVersion :: String -> String
    databaseVersion x :: String
    x = "SHAKE-DATABASE-14-" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    os String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ "-" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    arch String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ "-" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++  String
    s String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ "\r\n"
        where s :: String
    s = String -> String
    forall a. [a] -> [a]
    tail (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $ String -> String
    forall a. [a] -> [a]
    init (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $ String -> String
    forall a. Show a => a -> String
    show String
    x -- call show, then take off the leading/trailing quotes
                                       -- ensures we do not get \r or \n in the user portion

    messageCorrupt :: FilePath -> SomeException -> IO [String]
    messageCorrupt :: String -> SomeException -> IO [String]
    messageCorrupt dbfile :: String
    dbfile err :: SomeException
    err = do
        String
    msg <- SomeException -> IO String
    forall e. Show e => e -> IO String
    showException SomeException
    err
        [String] -> IO [String]
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ([String] -> IO [String]) -> [String] -> IO [String]
    forall a b. (a -> b) -> a -> b
    $
            ("Error when reading Shake database " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    dbfile) String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    :
            (String -> String) -> [String] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map ("  "String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++) (String -> [String]
    lines String
    msg) [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++
            ["All files will be rebuilt"]

    messageDatabaseVersionChange :: FilePath -> BS.ByteString -> BS.ByteString -> [String]
    messageDatabaseVersionChange :: String -> ByteString -> ByteString -> [String]
    messageDatabaseVersionChange dbfile :: String
    dbfile old :: ByteString
    old new :: ByteString
    new =
        ["Shake database version changed (either shake library version, or shakeVersion):"
        ,"  File:         " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    dbfile
        ,"  Old version:  " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    disp (String -> String
    limit (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $ ByteString -> String
    BS.unpack ByteString
    old)
        ,"  New version:  " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    disp (ByteString -> String
    BS.unpack ByteString
    new)
        ,"All rules will be rebuilt"]
        where
            limit :: String -> String
    limit x :: String
    x = let (a :: String
    a,b :: String
    b) = Int -> String -> (String, String)
    forall a. Int -> [a] -> ([a], [a])
    splitAt 200 String
    x in String
    a String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ (if String -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    b then "" else "...")
            disp :: String -> String
    disp = (Char -> Char) -> String -> String
    forall a b. (a -> b) -> [a] -> [b]
    map (\x :: Char
    x -> if Char -> Bool
    isPrint Char
    x Bool -> Bool -> Bool
    && Char -> Bool
    isAscii Char
    x then Char
    x else '?') (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> Bool) -> String -> String
    forall a. (a -> Bool) -> [a] -> [a]
    takeWhile (Char -> String -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `notElem` ("\r\n" :: String))

    messageMissingTypes :: FilePath -> [String] -> [String]
    messageMissingTypes :: String -> [String] -> [String]
    messageMissingTypes dbfile :: String
    dbfile types :: [String]
    types =
        ["Shake database rules have changed for the following types:"
        ,"  File:  " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    dbfile] [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++
        ["  Type:  " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    x | String
    x <- [String]
    types] [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++
        ["All rules using these types will be rebuilt"]

    -- | Storage of heterogeneous things. In the particular case of Shake,
    --   k ~ QTypeRep, v ~ (Key, Status{Value}).
    --
    --   The storage starts with a witness table saying what can be contained.
    --   If any entries in the witness table don't have a current Witness then a fake
    --   error witness is manufactured. If the witness ever changes the entire DB is
    --   rewritten.
    usingStorage
        :: (Show k, Eq k, Hashable k, NFData k, Show v, NFData v)
        => Cleanup
        -> ShakeOptions                                    -- ^ Storage options
        -> (IO String -> IO ())                            -- ^ Logging function
        -> Map.HashMap k (Ver, BinaryOp v)                 -- ^ Witnesses
        -> IO (Ids.Ids v, k -> Id -> v -> IO ())
    usingStorage :: Cleanup
    -> ShakeOptions
    -> (IO String -> IO ())
    -> HashMap k (Ver, BinaryOp v)
    -> IO (Ids v, k -> Id -> v -> IO ())
    usingStorage _ ShakeOptions{..} diagnostic :: IO String -> IO ()
    diagnostic _ | String
    shakeFiles String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == "/dev/null" = do
        IO String -> IO ()
    diagnostic (IO String -> IO ()) -> IO String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String -> IO String
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure "Using in-memory database"
        Ids v
    ids <- IO (Ids v)
    forall a. IO (Ids a)
    Ids.empty
        (Ids v, k -> Id -> v -> IO ()) -> IO (Ids v, k -> Id -> v -> IO ())
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Ids v
    ids, \_ _ _ -> () -> IO ()
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ())

    usingStorage cleanup :: Cleanup
    cleanup ShakeOptions{..} diagnostic :: IO String -> IO ()
    diagnostic witness :: HashMap k (Ver, BinaryOp v)
    witness = do
        let lockFile :: String
    lockFile = String
    shakeFiles String -> String -> String
    </> ".shake.lock"
        IO String -> IO ()
    diagnostic (IO String -> IO ()) -> IO String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String -> IO String
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (String -> IO String) -> String -> IO String
    forall a b. (a -> b) -> a -> b
    $ "Before usingLockFile on " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    lockFile
        Cleanup -> String -> IO ()
    usingLockFile Cleanup
    cleanup String
    lockFile
        IO String -> IO ()
    diagnostic (IO String -> IO ()) -> IO String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String -> IO String
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure "After usingLockFile"

        let dbfile :: String
    dbfile = String
    shakeFiles String -> String -> String
    </> ".shake.database"
        String -> IO ()
    createDirectoryRecursive String
    shakeFiles

        -- complete a partially failed compress
        IO Bool -> IO () -> IO ()
    forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
    whenM (String -> IO Bool
    restoreChunksBackup String
    dbfile) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
            String -> IO ()
    unexpected "Backup file exists, restoring over the previous file\n"
            IO String -> IO ()
    diagnostic (IO String -> IO ()) -> IO String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String -> IO String
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure "Backup file move to original"

        String -> IO ()
    addTiming "Database read"
        Chunks
    h <- Cleanup -> String -> Maybe Seconds -> IO Chunks
    usingChunks Cleanup
    cleanup String
    dbfile Maybe Seconds
    shakeFlush
        let corrupt :: IO ()
    corrupt
                | Bool -> Bool
    not Bool
    shakeStorageLog = Maybe String -> Chunks -> IO ()
    resetChunksCorrupt Maybe String
    forall a. Maybe a
    Nothing Chunks
    h
                | Bool
    otherwise = do
                    let file :: String
    file = String
    dbfile String -> String -> String
    <.> "corrupt"
                    Maybe String -> Chunks -> IO ()
    resetChunksCorrupt (String -> Maybe String
    forall a. a -> Maybe a
    Just String
    file) Chunks
    h
                    String -> IO ()
    unexpected (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ "Backup of corrupted file stored at " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    file String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ "\n"

        -- check the version information matches
        let ver :: ByteString
    ver = String -> ByteString
    BS.pack (String -> ByteString) -> String -> ByteString
    forall a b. (a -> b) -> a -> b
    $ String -> String
    databaseVersion String
    shakeVersion
        Either ByteString ByteString
    oldVer <- Chunks -> Word32 -> IO (Either ByteString ByteString)
    readChunkMax Chunks
    h (Word32 -> IO (Either ByteString ByteString))
    -> Word32 -> IO (Either ByteString ByteString)
    forall a b. (a -> b) -> a -> b
    $ Int -> Word32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Word32) -> Int -> Word32
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Int
    BS.length ByteString
    ver Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + 100000
        let verEq :: Bool
    verEq = ByteString -> Either ByteString ByteString
    forall a b. b -> Either a b
    Right ByteString
    ver Either ByteString ByteString
    -> Either ByteString ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    == Either ByteString ByteString
    oldVer
        Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Bool -> Bool
    not Bool
    shakeVersionIgnore Bool -> Bool -> Bool
    && Bool -> Bool
    not Bool
    verEq Bool -> Bool -> Bool
    && Either ByteString ByteString
    oldVer Either ByteString ByteString
    -> Either ByteString ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    /= ByteString -> Either ByteString ByteString
    forall a b. a -> Either a b
    Left ByteString
    BS.empty) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
            [String] -> IO ()
    outputErr ([String] -> IO ()) -> [String] -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String -> ByteString -> ByteString -> [String]
    messageDatabaseVersionChange String
    dbfile (Either ByteString ByteString -> ByteString
    forall a. Either a a -> a
    fromEither Either ByteString ByteString
    oldVer) ByteString
    ver
            IO ()
    corrupt

        (!ByteString
    witnessNew, !k -> Id -> v -> Builder
    save) <- (ByteString, k -> Id -> v -> Builder)
    -> IO (ByteString, k -> Id -> v -> Builder)
    forall a. a -> IO a
    evaluate ((ByteString, k -> Id -> v -> Builder)
     -> IO (ByteString, k -> Id -> v -> Builder))
    -> (ByteString, k -> Id -> v -> Builder)
    -> IO (ByteString, k -> Id -> v -> Builder)
    forall a b. (a -> b) -> a -> b
    $ HashMap k (Ver, BinaryOp v)
    -> (ByteString, k -> Id -> v -> Builder)
    forall k v.
    (Eq k, Hashable k, Show k) =>
    HashMap k (Ver, BinaryOp v)
    -> (ByteString, k -> Id -> v -> Builder)
    saveWitness HashMap k (Ver, BinaryOp v)
    witness
        Either ByteString ByteString
    witnessOld <- Chunks -> IO (Either ByteString ByteString)
    readChunk Chunks
    h
        Maybe (Ids v)
    ids <- case Either ByteString ByteString
    witnessOld of
            Left _ -> do
                Maybe String -> Chunks -> IO ()
    resetChunksCorrupt Maybe String
    forall a. Maybe a
    Nothing Chunks
    h
                Maybe (Ids v) -> IO (Maybe (Ids v))
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe (Ids v)
    forall a. Maybe a
    Nothing
            Right witnessOld :: ByteString
    witnessOld ->  (SomeException -> Bool)
    -> (SomeException -> IO (Maybe (Ids v)))
    -> IO (Maybe (Ids v))
    -> IO (Maybe (Ids v))
    forall e a.
    Exception e =>
    (e -> Bool) -> (e -> IO a) -> IO a -> IO a
    handleBool (Bool -> Bool
    not (Bool -> Bool) -> (SomeException -> Bool) -> SomeException -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SomeException -> Bool
    isAsyncException) (\err :: SomeException
    err -> do
                [String] -> IO ()
    outputErr ([String] -> IO ()) -> IO [String] -> IO ()
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< String -> SomeException -> IO [String]
    messageCorrupt String
    dbfile SomeException
    err
                IO ()
    corrupt
                Maybe (Ids v) -> IO (Maybe (Ids v))
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe (Ids v)
    forall a. Maybe a
    Nothing) (IO (Maybe (Ids v)) -> IO (Maybe (Ids v)))
    -> IO (Maybe (Ids v)) -> IO (Maybe (Ids v))
    forall a b. (a -> b) -> a -> b
    $ do

                (![String]
    missing, !ByteString -> (Id, Maybe (k, v))
    load) <- ([String], ByteString -> (Id, Maybe (k, v)))
    -> IO ([String], ByteString -> (Id, Maybe (k, v)))
    forall a. a -> IO a
    evaluate (([String], ByteString -> (Id, Maybe (k, v)))
     -> IO ([String], ByteString -> (Id, Maybe (k, v))))
    -> ([String], ByteString -> (Id, Maybe (k, v)))
    -> IO ([String], ByteString -> (Id, Maybe (k, v)))
    forall a b. (a -> b) -> a -> b
    $ HashMap k (Ver, BinaryOp v)
    -> ByteString -> ([String], ByteString -> (Id, Maybe (k, v)))
    forall k v.
    Show k =>
    HashMap k (Ver, BinaryOp v)
    -> ByteString -> ([String], ByteString -> (Id, Maybe (k, v)))
    loadWitness HashMap k (Ver, BinaryOp v)
    witness ByteString
    witnessOld
                Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when ([String]
    missing [String] -> [String] -> Bool
    forall a. Eq a => a -> a -> Bool
    /= []) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [String] -> IO ()
    outputErr ([String] -> IO ()) -> [String] -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String -> [String] -> [String]
    messageMissingTypes String
    dbfile [String]
    missing
                Ids (k, v)
    ids <- IO (Ids (k, v))
    forall a. IO (Ids a)
    Ids.empty
                let raw :: ByteString -> String
    raw bs :: ByteString
    bs = "[len " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show (ByteString -> Int
    BS.length ByteString
    bs) String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ "] " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [String] -> String
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat
                                [['0' | String -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    c Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == 1] String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    c | Word8
    x <- ByteString -> [Word8]
    BS8.unpack ByteString
    bs, let c :: String
    c = Word8 -> String -> String
    forall a. (Integral a, Show a) => a -> String -> String
    showHex Word8
    x ""]
                let go :: a -> IO a
    go !a
    i = do
                        Either ByteString ByteString
    v <- Chunks -> IO (Either ByteString ByteString)
    readChunk Chunks
    h
                        case Either ByteString ByteString
    v of
                            Left e :: ByteString
    e -> do
                                let slop :: Integer
    slop = Int -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Integer) -> Int -> Integer
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Int
    BS.length ByteString
    e
                                Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Integer
    slop Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    > 0) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String -> IO ()
    unexpected (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ "Last " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Integer -> String
    forall a. Show a => a -> String
    show Integer
    slop String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ " bytes do not form a whole record\n"
                                IO String -> IO ()
    diagnostic (IO String -> IO ()) -> IO String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String -> IO String
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (String -> IO String) -> String -> IO String
    forall a b. (a -> b) -> a -> b
    $ "Read " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ a -> String
    forall a. Show a => a -> String
    show a
    i String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ " chunks, plus " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Integer -> String
    forall a. Show a => a -> String
    show Integer
    slop String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ " slop"
                                a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure a
    i
                            Right bs :: ByteString
    bs | (id :: Id
    id, Just (k :: k
    k,v :: v
    v)) <- ByteString -> (Id, Maybe (k, v))
    load ByteString
    bs -> do
                                () -> IO ()
    forall a. a -> IO a
    evaluate (() -> IO ()) -> () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ k -> ()
    forall a. NFData a => a -> ()
    rnf k
    k
                                () -> IO ()
    forall a. a -> IO a
    evaluate (() -> IO ()) -> () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ v -> ()
    forall a. NFData a => a -> ()
    rnf v
    v
                                Ids (k, v) -> Id -> (k, v) -> IO ()
    forall a. Ids a -> Id -> a -> IO ()
    Ids.insert Ids (k, v)
    ids Id
    id (k
    k,v
    v)
                                IO String -> IO ()
    diagnostic (IO String -> IO ()) -> IO String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
                                    let pretty :: Either a String -> String
    pretty (Left x :: a
    x) = "FAILURE: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ a -> String
    forall a. Show a => a -> String
    show a
    x
                                        pretty (Right x :: String
    x) = String
    x
                                    Either SomeException String
    x2 <- IO String -> IO (Either SomeException String)
    forall a. IO a -> IO (Either SomeException a)
    try_ (IO String -> IO (Either SomeException String))
    -> IO String -> IO (Either SomeException String)
    forall a b. (a -> b) -> a -> b
    $ String -> IO String
    forall a. a -> IO a
    evaluate (String -> IO String) -> String -> IO String
    forall a b. (a -> b) -> a -> b
    $ let s :: String
    s = v -> String
    forall a. Show a => a -> String
    show v
    v in String -> ()
    forall a. NFData a => a -> ()
    rnf String
    s () -> String -> String
    forall a b. a -> b -> b
    `seq` String
    s
                                    String -> IO String
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (String -> IO String) -> String -> IO String
    forall a b. (a -> b) -> a -> b
    $ "Chunk " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ a -> String
    forall a. Show a => a -> String
    show a
    i String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ " " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ ByteString -> String
    raw ByteString
    bs String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ " " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Id -> String
    forall a. Show a => a -> String
    show Id
    id String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ " = " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Either SomeException String -> String
    forall a. Show a => Either a String -> String
    pretty Either SomeException String
    x2
                                a -> IO a
    go (a -> IO a) -> a -> IO a
    forall a b. (a -> b) -> a -> b
    $ a
    ia -> a -> a
    forall a. Num a => a -> a -> a
    +1
                            Right bs :: ByteString
    bs -> do
                                IO String -> IO ()
    diagnostic (IO String -> IO ()) -> IO String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String -> IO String
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (String -> IO String) -> String -> IO String
    forall a b. (a -> b) -> a -> b
    $ "Chunk " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ a -> String
    forall a. Show a => a -> String
    show a
    i String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ " " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ ByteString -> String
    raw ByteString
    bs String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ " UNKNOWN WITNESS"
                                a -> IO a
    go a
    i
                Int
    countItems <- Int -> IO Int
    forall a. (Show a, Num a) => a -> IO a
    go 0
                Int
    countDistinct <- Ids (k, v) -> IO Int
    forall a. Ids a -> IO Int
    Ids.sizeUpperBound Ids (k, v)
    ids
                IO String -> IO ()
    diagnostic (IO String -> IO ()) -> IO String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String -> IO String
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (String -> IO String) -> String -> IO String
    forall a b. (a -> b) -> a -> b
    $ "Found at most " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show Int
    countDistinct String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ " distinct entries out of " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show Int
    countItems

                Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Int
    countItems Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    countDistinctInt -> Int -> Int
    forall a. Num a => a -> a -> a
    *2 Bool -> Bool -> Bool
    || Bool -> Bool
    not Bool
    verEq Bool -> Bool -> Bool
    || ByteString
    witnessOld ByteString -> ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    /= ByteString
    witnessNew) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
                    String -> IO ()
    addTiming "Database compression"
                    Chunks -> ((Builder -> IO ()) -> IO ()) -> IO ()
    forall a. Chunks -> ((Builder -> IO ()) -> IO a) -> IO a
    resetChunksCompact Chunks
    h (((Builder -> IO ()) -> IO ()) -> IO ())
    -> ((Builder -> IO ()) -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \out :: Builder -> IO ()
    out -> do
                        Builder -> IO ()
    out (Builder -> IO ()) -> Builder -> IO ()
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Builder
    forall a. BinaryEx a => a -> Builder
    putEx ByteString
    ver
                        Builder -> IO ()
    out (Builder -> IO ()) -> Builder -> IO ()
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Builder
    forall a. BinaryEx a => a -> Builder
    putEx ByteString
    witnessNew
                        Ids (k, v) -> (Id -> (k, v) -> IO ()) -> IO ()
    forall a. Ids a -> (Id -> a -> IO ()) -> IO ()
    Ids.forWithKeyM_ Ids (k, v)
    ids ((Id -> (k, v) -> IO ()) -> IO ())
    -> (Id -> (k, v) -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \i :: Id
    i (k :: k
    k,v :: v
    v) -> Builder -> IO ()
    out (Builder -> IO ()) -> Builder -> IO ()
    forall a b. (a -> b) -> a -> b
    $ k -> Id -> v -> Builder
    save k
    k Id
    i v
    v
                Ids v -> Maybe (Ids v)
    forall a. a -> Maybe a
    Just (Ids v -> Maybe (Ids v)) -> IO (Ids v) -> IO (Maybe (Ids v))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Ids (k, v) -> ((k, v) -> v) -> IO (Ids v)
    forall a b. Ids a -> (a -> b) -> IO (Ids b)
    Ids.forCopy Ids (k, v)
    ids (k, v) -> v
    forall a b. (a, b) -> b
    snd

        Ids v
    ids <- case Maybe (Ids v)
    ids of
            Just ids :: Ids v
    ids -> Ids v -> IO (Ids v)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Ids v
    ids
            Nothing -> do
                Chunks -> Builder -> IO ()
    writeChunk Chunks
    h (Builder -> IO ()) -> Builder -> IO ()
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Builder
    forall a. BinaryEx a => a -> Builder
    putEx ByteString
    ver
                Chunks -> Builder -> IO ()
    writeChunk Chunks
    h (Builder -> IO ()) -> Builder -> IO ()
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Builder
    forall a. BinaryEx a => a -> Builder
    putEx ByteString
    witnessNew
                IO (Ids v)
    forall a. IO (Ids a)
    Ids.empty

        String -> IO ()
    addTiming "With database"
        Builder -> IO ()
    out <- Cleanup -> Chunks -> IO (Builder -> IO ())
    usingWriteChunks Cleanup
    cleanup Chunks
    h
        (Ids v, k -> Id -> v -> IO ()) -> IO (Ids v, k -> Id -> v -> IO ())
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Ids v
    ids, \k :: k
    k i :: Id
    i v :: v
    v -> Builder -> IO ()
    out (Builder -> IO ()) -> Builder -> IO ()
    forall a b. (a -> b) -> a -> b
    $ k -> Id -> v -> Builder
    save k
    k Id
    i v
    v)
        where
            unexpected :: String -> IO ()
    unexpected x :: String
    x = Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    shakeStorageLog (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
                UTCTime
    t <- IO UTCTime
    getCurrentTime
                String -> String -> IO ()
    appendFile (String
    shakeFiles String -> String -> String
    </> ".shake.storage.log") (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ "\n[" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ UTCTime -> String
    forall a. Show a => a -> String
    show UTCTime
    t String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ "]: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    trimEnd String
    x String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ "\n"
            outputErr :: [String] -> IO ()
    outputErr x :: [String]
    x = do
                Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Verbosity
    shakeVerbosity Verbosity -> Verbosity -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Verbosity
    Warn) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Verbosity -> String -> IO ()
    shakeOutput Verbosity
    Warn (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [String] -> String
    unlines [String]
    x
                String -> IO ()
    unexpected (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [String] -> String
    unlines [String]
    x

    -- | A list oft witnesses, saved
    type Witnesses = BS.ByteString

    -- | The version and key, serialised
    newtype Witness = Witness BS.ByteString
        deriving (Witness -> Witness -> Bool
    (Witness -> Witness -> Bool)
    -> (Witness -> Witness -> Bool) -> Eq Witness
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: Witness -> Witness -> Bool
    $c/= :: Witness -> Witness -> Bool
    == :: Witness -> Witness -> Bool
    $c== :: Witness -> Witness -> Bool
    Eq, Int -> Witness -> Int
    Witness -> Int
    (Int -> Witness -> Int) -> (Witness -> Int) -> Hashable Witness
    forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
    hash :: Witness -> Int
    $chash :: Witness -> Int
    hashWithSalt :: Int -> Witness -> Int
    $chashWithSalt :: Int -> Witness -> Int
    Hashable, Eq Witness
    Eq Witness =>
    (Witness -> Witness -> Ordering)
    -> (Witness -> Witness -> Bool)
    -> (Witness -> Witness -> Bool)
    -> (Witness -> Witness -> Bool)
    -> (Witness -> Witness -> Bool)
    -> (Witness -> Witness -> Witness)
    -> (Witness -> Witness -> Witness)
    -> Ord Witness
    Witness -> Witness -> Bool
    Witness -> Witness -> Ordering
    Witness -> Witness -> Witness
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    min :: Witness -> Witness -> Witness
    $cmin :: Witness -> Witness -> Witness
    max :: Witness -> Witness -> Witness
    $cmax :: Witness -> Witness -> Witness
    >= :: Witness -> Witness -> Bool
    $c>= :: Witness -> Witness -> Bool
    > :: Witness -> Witness -> Bool
    $c> :: Witness -> Witness -> Bool
    <= :: Witness -> Witness -> Bool
    $c<= :: Witness -> Witness -> Bool
    < :: Witness -> Witness -> Bool
    $c< :: Witness -> Witness -> Bool
    compare :: Witness -> Witness -> Ordering
    $ccompare :: Witness -> Witness -> Ordering
    $cp1Ord :: Eq Witness
    Ord)

    toWitness :: Show k => Ver -> k -> Witness
    toWitness :: Ver -> k -> Witness
    toWitness (Ver v :: Int
    v) k :: k
    k = ByteString -> Witness
    Witness (ByteString -> Witness) -> ByteString -> Witness
    forall a b. (a -> b) -> a -> b
    $ String -> ByteString
    UTF8.fromString (k -> String
    forall a. Show a => a -> String
    show k
    k String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ (if Int
    v Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == 0 then "" else ", v" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show Int
    v))

    instance BinaryEx [Witness] where
        putEx :: [Witness] -> Builder
    putEx xs :: [Witness]
    xs = [ByteString] -> Builder
    forall a. BinaryEx a => a -> Builder
    putEx [ByteString
    x | Witness x :: ByteString
    x <- [Witness]
    xs]
        getEx :: ByteString -> [Witness]
    getEx = (ByteString -> Witness) -> [ByteString] -> [Witness]
    forall a b. (a -> b) -> [a] -> [b]
    map ByteString -> Witness
    Witness ([ByteString] -> [Witness])
    -> (ByteString -> [ByteString]) -> ByteString -> [Witness]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> [ByteString]
    forall a. BinaryEx a => ByteString -> a
    getEx

    -- | Given the current witness table, and the serialised one from last time, return
    --   (witnesses that got removed, way to deserialise an entry into an Id, and (if the witness remains) the key and value)
    loadWitness :: forall k v . Show k => Map.HashMap k (Ver, BinaryOp v) -> Witnesses -> ([String], BS.ByteString -> (Id, Maybe (k, v)))
    loadWitness :: HashMap k (Ver, BinaryOp v)
    -> ByteString -> ([String], ByteString -> (Id, Maybe (k, v)))
    loadWitness mp :: HashMap k (Ver, BinaryOp v)
    mp bs :: ByteString
    bs = (,) [String]
    missing ((ByteString -> (Id, Maybe (k, v)))
     -> ([String], ByteString -> (Id, Maybe (k, v))))
    -> (ByteString -> (Id, Maybe (k, v)))
    -> ([String], ByteString -> (Id, Maybe (k, v)))
    forall a b. (a -> b) -> a -> b
    $ (Int -> Maybe (ByteString -> Maybe (k, v)))
    -> (ByteString -> (Id, Maybe (k, v)))
    -> ByteString
    -> (Id, Maybe (k, v))
    forall a b. a -> b -> b
    seq Int -> Maybe (ByteString -> Maybe (k, v))
    ind ((ByteString -> (Id, Maybe (k, v)))
     -> ByteString -> (Id, Maybe (k, v)))
    -> (ByteString -> (Id, Maybe (k, v)))
    -> ByteString
    -> (Id, Maybe (k, v))
    forall a b. (a -> b) -> a -> b
    $ \bs :: ByteString
    bs ->
                let (Word16
    wInd :: Word16, Id
    i :: Id, bs2 :: ByteString
    bs2) = ByteString -> (Word16, Id, ByteString)
    forall a b.
    (Storable a, Storable b) =>
    ByteString -> (a, b, ByteString)
    binarySplit2 ByteString
    bs
                in case Int -> Maybe (ByteString -> Maybe (k, v))
    ind (Word16 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word16
    wInd) of
                        Nothing -> SomeException -> (Id, Maybe (k, v))
    forall a. SomeException -> a
    throwImpure (SomeException -> (Id, Maybe (k, v)))
    -> SomeException -> (Id, Maybe (k, v))
    forall a b. (a -> b) -> a -> b
    $ Partial => String -> SomeException
    String -> SomeException
    errorInternal (String -> SomeException) -> String -> SomeException
    forall a b. (a -> b) -> a -> b
    $ "Witness index out of bounds, " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Word16 -> String
    forall a. Show a => a -> String
    show Word16
    wInd
                        Just f :: ByteString -> Maybe (k, v)
    f -> (Id
    i, ByteString -> Maybe (k, v)
    f ByteString
    bs2)
        where
            [Witness]
    ws :: [Witness] = ByteString -> [Witness]
    forall a. BinaryEx a => ByteString -> a
    getEx ByteString
    bs
            missing :: [String]
    missing = [ByteString -> String
    UTF8.toString ByteString
    w | (i :: Int
    i, Witness w :: ByteString
    w) <- Int -> [Witness] -> [(Int, Witness)]
    forall a b. Enum a => a -> [b] -> [(a, b)]
    zipFrom 0 [Witness]
    ws, Maybe (k, v) -> Bool
    forall a. Maybe a -> Bool
    isNothing (Maybe (k, v) -> Bool) -> Maybe (k, v) -> Bool
    forall a b. (a -> b) -> a -> b
    $ Maybe (ByteString -> Maybe (k, v)) -> ByteString -> Maybe (k, v)
    forall a. Partial => Maybe a -> a
    fromJust (Int -> Maybe (ByteString -> Maybe (k, v))
    ind Int
    i) ByteString
    BS.empty]

            HashMap Witness (k, BinaryOp v)
    mp2 :: Map.HashMap Witness (k, BinaryOp v) = [(Witness, (k, BinaryOp v))] -> HashMap Witness (k, BinaryOp v)
    forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
    Map.fromList [(Ver -> k -> Witness
    forall k. Show k => Ver -> k -> Witness
    toWitness Ver
    ver k
    k, (k
    k, BinaryOp v
    bin)) | (k :: k
    k,(ver :: Ver
    ver,bin :: BinaryOp v
    bin)) <- HashMap k (Ver, BinaryOp v) -> [(k, (Ver, BinaryOp v))]
    forall k v. HashMap k v -> [(k, v)]
    Map.toList HashMap k (Ver, BinaryOp v)
    mp]

            Int -> Maybe (ByteString -> Maybe (k, v))
    ind :: (Int -> Maybe (BS.ByteString -> Maybe (k, v))) = HashMap Witness (k, BinaryOp v)
    -> (Int -> Maybe (ByteString -> Maybe (k, v)))
    -> Int
    -> Maybe (ByteString -> Maybe (k, v))
    forall a b. a -> b -> b
    seq HashMap Witness (k, BinaryOp v)
    mp2 ((Int -> Maybe (ByteString -> Maybe (k, v)))
     -> Int -> Maybe (ByteString -> Maybe (k, v)))
    -> (Int -> Maybe (ByteString -> Maybe (k, v)))
    -> Int
    -> Maybe (ByteString -> Maybe (k, v))
    forall a b. (a -> b) -> a -> b
    $ [ByteString -> Maybe (k, v)]
    -> Int -> Maybe (ByteString -> Maybe (k, v))
    forall a. [a] -> Int -> Maybe a
    fastAt ([ByteString -> Maybe (k, v)]
     -> Int -> Maybe (ByteString -> Maybe (k, v)))
    -> [ByteString -> Maybe (k, v)]
    -> Int
    -> Maybe (ByteString -> Maybe (k, v))
    forall a b. (a -> b) -> a -> b
    $ ((Witness -> ByteString -> Maybe (k, v))
     -> [Witness] -> [ByteString -> Maybe (k, v)])
    -> [Witness]
    -> (Witness -> ByteString -> Maybe (k, v))
    -> [ByteString -> Maybe (k, v)]
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip (Witness -> ByteString -> Maybe (k, v))
    -> [Witness] -> [ByteString -> Maybe (k, v)]
    forall a b. (a -> b) -> [a] -> [b]
    map [Witness]
    ws ((Witness -> ByteString -> Maybe (k, v))
     -> [ByteString -> Maybe (k, v)])
    -> (Witness -> ByteString -> Maybe (k, v))
    -> [ByteString -> Maybe (k, v)]
    forall a b. (a -> b) -> a -> b
    $ \w :: Witness
    w ->
                case Witness -> HashMap Witness (k, BinaryOp v) -> Maybe (k, BinaryOp v)
    forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
    Map.lookup Witness
    w HashMap Witness (k, BinaryOp v)
    mp2 of
                    Nothing -> Maybe (k, v) -> ByteString -> Maybe (k, v)
    forall a b. a -> b -> a
    const Maybe (k, v)
    forall a. Maybe a
    Nothing
                    Just (k :: k
    k, BinaryOp{..}) -> \bs :: ByteString
    bs -> (k, v) -> Maybe (k, v)
    forall a. a -> Maybe a
    Just (k
    k, ByteString -> v
    getOp ByteString
    bs)

    saveWitness :: forall k v . (Eq k, Hashable k, Show k) => Map.HashMap k (Ver, BinaryOp v) -> (Witnesses, k -> Id -> v -> Builder)
    saveWitness :: HashMap k (Ver, BinaryOp v)
    -> (ByteString, k -> Id -> v -> Builder)
    saveWitness mp :: HashMap k (Ver, BinaryOp v)
    mp
        | HashMap k (Ver, BinaryOp v) -> Int
    forall k v. HashMap k v -> Int
    Map.size HashMap k (Ver, BinaryOp v)
    mp Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Word16 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word16
    forall a. Bounded a => a
    maxBound :: Word16) = SomeException -> (ByteString, k -> Id -> v -> Builder)
    forall a. SomeException -> a
    throwImpure (SomeException -> (ByteString, k -> Id -> v -> Builder))
    -> SomeException -> (ByteString, k -> Id -> v -> Builder)
    forall a b. (a -> b) -> a -> b
    $ Partial => String -> SomeException
    String -> SomeException
    errorInternal (String -> SomeException) -> String -> SomeException
    forall a b. (a -> b) -> a -> b
    $ "Number of distinct witness types exceeds limit, got " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show (HashMap k (Ver, BinaryOp v) -> Int
    forall k v. HashMap k v -> Int
    Map.size HashMap k (Ver, BinaryOp v)
    mp)
        | Bool
    otherwise = (Builder -> ByteString
    runBuilder (Builder -> ByteString) -> Builder -> ByteString
    forall a b. (a -> b) -> a -> b
    $ [Witness] -> Builder
    forall a. BinaryEx a => a -> Builder
    putEx [Witness]
    ws
                      ,HashMap k (Id -> v -> Builder)
    mpSave HashMap k (Id -> v -> Builder)
    -> (k -> Id -> v -> Builder) -> k -> Id -> v -> Builder
    forall a b. a -> b -> b
    `seq` \k :: k
    k -> (Id -> v -> Builder)
    -> Maybe (Id -> v -> Builder) -> Id -> v -> Builder
    forall a. a -> Maybe a -> a
    fromMaybe (SomeException -> Id -> v -> Builder
    forall a. SomeException -> a
    throwImpure (SomeException -> Id -> v -> Builder)
    -> SomeException -> Id -> v -> Builder
    forall a b. (a -> b) -> a -> b
    $ Partial => String -> SomeException
    String -> SomeException
    errorInternal (String -> SomeException) -> String -> SomeException
    forall a b. (a -> b) -> a -> b
    $ "Don't know how to save, " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ k -> String
    forall a. Show a => a -> String
    show k
    k) (Maybe (Id -> v -> Builder) -> Id -> v -> Builder)
    -> Maybe (Id -> v -> Builder) -> Id -> v -> Builder
    forall a b. (a -> b) -> a -> b
    $ k -> HashMap k (Id -> v -> Builder) -> Maybe (Id -> v -> Builder)
    forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
    Map.lookup k
    k HashMap k (Id -> v -> Builder)
    mpSave)
        where
            -- the entries in the witness table (in a stable order, to make it more likely to get a good equality)
            [Witness]
    ws :: [Witness] = [Witness] -> [Witness]
    forall a. Ord a => [a] -> [a]
    sort ([Witness] -> [Witness]) -> [Witness] -> [Witness]
    forall a b. (a -> b) -> a -> b
    $ ((k, (Ver, BinaryOp v)) -> Witness)
    -> [(k, (Ver, BinaryOp v))] -> [Witness]
    forall a b. (a -> b) -> [a] -> [b]
    map (\(k :: k
    k,(ver :: Ver
    ver,_)) -> Ver -> k -> Witness
    forall k. Show k => Ver -> k -> Witness
    toWitness Ver
    ver k
    k) ([(k, (Ver, BinaryOp v))] -> [Witness])
    -> [(k, (Ver, BinaryOp v))] -> [Witness]
    forall a b. (a -> b) -> a -> b
    $ HashMap k (Ver, BinaryOp v) -> [(k, (Ver, BinaryOp v))]
    forall k v. HashMap k v -> [(k, v)]
    Map.toList HashMap k (Ver, BinaryOp v)
    mp

            -- an index for each of the witness entries
            HashMap Witness Word16
    wsIndex :: Map.HashMap Witness Word16 = [(Witness, Word16)] -> HashMap Witness Word16
    forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
    Map.fromList ([(Witness, Word16)] -> HashMap Witness Word16)
    -> [(Witness, Word16)] -> HashMap Witness Word16
    forall a b. (a -> b) -> a -> b
    $ [Witness] -> [Word16] -> [(Witness, Word16)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Witness]
    ws [0 :: Word16 ..]

            -- the save functions
            HashMap k (Id -> v -> Builder)
    mpSave :: Map.HashMap k (Id -> v -> Builder) = ((k -> (Ver, BinaryOp v) -> Id -> v -> Builder)
     -> HashMap k (Ver, BinaryOp v) -> HashMap k (Id -> v -> Builder))
    -> HashMap k (Ver, BinaryOp v)
    -> (k -> (Ver, BinaryOp v) -> Id -> v -> Builder)
    -> HashMap k (Id -> v -> Builder)
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip (k -> (Ver, BinaryOp v) -> Id -> v -> Builder)
    -> HashMap k (Ver, BinaryOp v) -> HashMap k (Id -> v -> Builder)
    forall k v1 v2. (k -> v1 -> v2) -> HashMap k v1 -> HashMap k v2
    Map.mapWithKey HashMap k (Ver, BinaryOp v)
    mp ((k -> (Ver, BinaryOp v) -> Id -> v -> Builder)
     -> HashMap k (Id -> v -> Builder))
    -> (k -> (Ver, BinaryOp v) -> Id -> v -> Builder)
    -> HashMap k (Id -> v -> Builder)
    forall a b. (a -> b) -> a -> b
    $
                \k :: k
    k (ver :: Ver
    ver,BinaryOp{..}) ->
                    let tag :: Builder
    tag = Word16 -> Builder
    forall a. BinaryEx a => a -> Builder
    putEx (Word16 -> Builder) -> Word16 -> Builder
    forall a b. (a -> b) -> a -> b
    $ HashMap Witness Word16
    wsIndex HashMap Witness Word16 -> Witness -> Word16
    forall k v. (Eq k, Hashable k) => HashMap k v -> k -> v
    Map.! Ver -> k -> Witness
    forall k. Show k => Ver -> k -> Witness
    toWitness Ver
    ver k
    k
                    in \(Id w :: Word32
    w) v :: v
    v -> Builder
    tag Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Word32 -> Builder
    forall a. BinaryEx a => a -> Builder
    putEx Word32
    w Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> v -> Builder
    putOp v
    v