{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveLift #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskellQuotes #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ViewPatterns #-}

{-# OPTIONS_GHC -fno-warn-orphans #-}

-- |
-- Module: Test.Hash.Internal
-- Copyright: Copyright © 2022-2024 Lars Kuhtz <lakuhtz@gmail.com>
-- License: MIT
-- Maintainer: Lars Kuhtz <lakuhtz@gmail.com>
-- Stability: experimental
-- Description: Internal Definitions
--
module Test.Hash.Internal
(
-- * Validation Tests for SHA1, SHA2, and SHA3 Hash Algorithms
-- **  Response Files for Selected Long And Short Messages Test for Byte-Oriented Implementations
  MsgFile(..)
, MsgVector(..)
, readMsgFile
, embedMsgFile

-- ** Response Files for Pseudorandomly Generated Messages (Monte Carlo) Tests
, MonteFile(..)
, MonteVector(..)
, readMonteFile
, embedMonteFile

-- * Validation Tests for SHA3-XOFs (Shake) Hash Algorithms
-- **  Response Files for Selected Long And Short Messages Test for Byte-Oriented Implementations
, ShakeMsgFile(..)
, ShakeMsgVector(..)
, readShakeMsgFile
, embedShakeMsgFile

-- ** Response Files for Pseudorandomly Generated Messages (Monte Carlo) Tests
, ShakeMonteFile(..)
, ShakeMonteVector(..)
, readShakeMonteFile
, embedShakeMonteFile

-- ** Response Files for Variable Output Tests for Byte-Oriented Implementations
, ShakeVarOutFile(..)
, ShakeVarOutVector(..)
, readShakeVarOutFile
, embedShakeVarOutFile

-- * Test Tools
, msgTest
, msgAssert
, monteTestInternal
, monteAssertInternal

-- * Internal: Embedding Response Files in Haskell Code
, embedIO

) where

import Control.Applicative
import Control.Monad

import Data.Attoparsec.Text.Lazy
import Data.ByteString qualified as B
import Data.ByteString.Base16 qualified as B16
import Data.ByteString.Char8 qualified as B8
import Data.ByteString.Internal qualified as B (ByteString(..))
import Data.ByteString.Unsafe qualified as B
import Data.Foldable
import Data.Functor
import Data.List qualified as L
import Data.Maybe
import Data.Text qualified as T
import Data.Text.Encoding qualified as T
import Data.Text.Lazy qualified as TL
import Data.Text.Lazy.IO qualified as TL
import Data.Vector qualified as V

import Language.Haskell.TH
import Language.Haskell.TH.Syntax

import Numeric.Natural

import System.Directory
import System.FilePath
import System.IO.Unsafe

-- -------------------------------------------------------------------------- --
-- Backward compatibility for template-haskell-2.16.0

#if MIN_VERSION_template_haskell(2,17,0)
code :: m (TExp a) -> Code m a
code :: forall (m :: * -> *) a. m (TExp a) -> Code m a
code = m (TExp a) -> Code m a
forall (m :: * -> *) a. m (TExp a) -> Code m a
Code
#else
type Code a b = a (TExp b)

code :: a -> a
code = id

bindCode :: Q a -> (a -> Q (TExp a)) -> Code Q a
bindCode act l = act >>= l
#endif

-- -------------------------------------------------------------------------- --
-- Msg File

data MsgFile = MsgFile
    { MsgFile -> Text
_msgDescription :: !T.Text
    , MsgFile -> Natural
_msgL :: !Natural
    , MsgFile -> Vector MsgVector
_msgVectors :: !(V.Vector MsgVector)
    }
    deriving (Int -> MsgFile -> ShowS
[MsgFile] -> ShowS
MsgFile -> String
(Int -> MsgFile -> ShowS)
-> (MsgFile -> String) -> ([MsgFile] -> ShowS) -> Show MsgFile
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MsgFile -> ShowS
showsPrec :: Int -> MsgFile -> ShowS
$cshow :: MsgFile -> String
show :: MsgFile -> String
$cshowList :: [MsgFile] -> ShowS
showList :: [MsgFile] -> ShowS
Show, MsgFile -> MsgFile -> Bool
(MsgFile -> MsgFile -> Bool)
-> (MsgFile -> MsgFile -> Bool) -> Eq MsgFile
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MsgFile -> MsgFile -> Bool
== :: MsgFile -> MsgFile -> Bool
$c/= :: MsgFile -> MsgFile -> Bool
/= :: MsgFile -> MsgFile -> Bool
Eq, Eq MsgFile
Eq MsgFile =>
(MsgFile -> MsgFile -> Ordering)
-> (MsgFile -> MsgFile -> Bool)
-> (MsgFile -> MsgFile -> Bool)
-> (MsgFile -> MsgFile -> Bool)
-> (MsgFile -> MsgFile -> Bool)
-> (MsgFile -> MsgFile -> MsgFile)
-> (MsgFile -> MsgFile -> MsgFile)
-> Ord MsgFile
MsgFile -> MsgFile -> Bool
MsgFile -> MsgFile -> Ordering
MsgFile -> MsgFile -> MsgFile
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 :: MsgFile -> MsgFile -> Ordering
compare :: MsgFile -> MsgFile -> Ordering
$c< :: MsgFile -> MsgFile -> Bool
< :: MsgFile -> MsgFile -> Bool
$c<= :: MsgFile -> MsgFile -> Bool
<= :: MsgFile -> MsgFile -> Bool
$c> :: MsgFile -> MsgFile -> Bool
> :: MsgFile -> MsgFile -> Bool
$c>= :: MsgFile -> MsgFile -> Bool
>= :: MsgFile -> MsgFile -> Bool
$cmax :: MsgFile -> MsgFile -> MsgFile
max :: MsgFile -> MsgFile -> MsgFile
$cmin :: MsgFile -> MsgFile -> MsgFile
min :: MsgFile -> MsgFile -> MsgFile
Ord)
    deriving ((forall (m :: * -> *). Quote m => MsgFile -> m Exp)
-> (forall (m :: * -> *). Quote m => MsgFile -> Code m MsgFile)
-> Lift MsgFile
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => MsgFile -> m Exp
forall (m :: * -> *). Quote m => MsgFile -> Code m MsgFile
$clift :: forall (m :: * -> *). Quote m => MsgFile -> m Exp
lift :: forall (m :: * -> *). Quote m => MsgFile -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => MsgFile -> Code m MsgFile
liftTyped :: forall (m :: * -> *). Quote m => MsgFile -> Code m MsgFile
Lift)

data MsgVector = MsgVector
    { MsgVector -> Natural
_msgLen :: !Natural
    , MsgVector -> ByteString
_msgMsg :: !B.ByteString
    , MsgVector -> ByteString
_msgMd :: !B.ByteString
    }
    deriving (Int -> MsgVector -> ShowS
[MsgVector] -> ShowS
MsgVector -> String
(Int -> MsgVector -> ShowS)
-> (MsgVector -> String)
-> ([MsgVector] -> ShowS)
-> Show MsgVector
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MsgVector -> ShowS
showsPrec :: Int -> MsgVector -> ShowS
$cshow :: MsgVector -> String
show :: MsgVector -> String
$cshowList :: [MsgVector] -> ShowS
showList :: [MsgVector] -> ShowS
Show, MsgVector -> MsgVector -> Bool
(MsgVector -> MsgVector -> Bool)
-> (MsgVector -> MsgVector -> Bool) -> Eq MsgVector
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MsgVector -> MsgVector -> Bool
== :: MsgVector -> MsgVector -> Bool
$c/= :: MsgVector -> MsgVector -> Bool
/= :: MsgVector -> MsgVector -> Bool
Eq, Eq MsgVector
Eq MsgVector =>
(MsgVector -> MsgVector -> Ordering)
-> (MsgVector -> MsgVector -> Bool)
-> (MsgVector -> MsgVector -> Bool)
-> (MsgVector -> MsgVector -> Bool)
-> (MsgVector -> MsgVector -> Bool)
-> (MsgVector -> MsgVector -> MsgVector)
-> (MsgVector -> MsgVector -> MsgVector)
-> Ord MsgVector
MsgVector -> MsgVector -> Bool
MsgVector -> MsgVector -> Ordering
MsgVector -> MsgVector -> MsgVector
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 :: MsgVector -> MsgVector -> Ordering
compare :: MsgVector -> MsgVector -> Ordering
$c< :: MsgVector -> MsgVector -> Bool
< :: MsgVector -> MsgVector -> Bool
$c<= :: MsgVector -> MsgVector -> Bool
<= :: MsgVector -> MsgVector -> Bool
$c> :: MsgVector -> MsgVector -> Bool
> :: MsgVector -> MsgVector -> Bool
$c>= :: MsgVector -> MsgVector -> Bool
>= :: MsgVector -> MsgVector -> Bool
$cmax :: MsgVector -> MsgVector -> MsgVector
max :: MsgVector -> MsgVector -> MsgVector
$cmin :: MsgVector -> MsgVector -> MsgVector
min :: MsgVector -> MsgVector -> MsgVector
Ord)
    deriving ((forall (m :: * -> *). Quote m => MsgVector -> m Exp)
-> (forall (m :: * -> *). Quote m => MsgVector -> Code m MsgVector)
-> Lift MsgVector
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => MsgVector -> m Exp
forall (m :: * -> *). Quote m => MsgVector -> Code m MsgVector
$clift :: forall (m :: * -> *). Quote m => MsgVector -> m Exp
lift :: forall (m :: * -> *). Quote m => MsgVector -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => MsgVector -> Code m MsgVector
liftTyped :: forall (m :: * -> *). Quote m => MsgVector -> Code m MsgVector
Lift)

pMsgFile :: Parser MsgFile
pMsgFile :: Parser MsgFile
pMsgFile = Text -> Natural -> Vector MsgVector -> MsgFile
MsgFile
    (Text -> Natural -> Vector MsgVector -> MsgFile)
-> Parser Text Text
-> Parser Text (Natural -> Vector MsgVector -> MsgFile)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Text
pDescription
    Parser Text (Natural -> Vector MsgVector -> MsgFile)
-> Parser Text Natural -> Parser Text (Vector MsgVector -> MsgFile)
forall a b. Parser Text (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ()
skipSpace Parser () -> Parser Text Natural -> Parser Text Natural
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text Natural
pL)
    Parser Text (Vector MsgVector -> MsgFile)
-> Parser Text (Vector MsgVector) -> Parser MsgFile
forall a b. Parser Text (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ()
skipSpace Parser ()
-> Parser Text (Vector MsgVector) -> Parser Text (Vector MsgVector)
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text (Vector MsgVector)
pVectors)
    Parser MsgFile -> Parser () -> Parser MsgFile
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (Parser ()
skipSpace Parser () -> Parser () -> Parser ()
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
forall t. Chunk t => Parser t ()
endOfInput)
    Parser MsgFile -> String -> Parser MsgFile
forall i a. Parser i a -> String -> Parser i a
<?> String
"RspMsgFile"
  where
    pVectors :: Parser (V.Vector MsgVector)
    pVectors :: Parser Text (Vector MsgVector)
pVectors = [MsgVector] -> Vector MsgVector
forall a. [a] -> Vector a
V.fromList
        ([MsgVector] -> Vector MsgVector)
-> Parser Text [MsgVector] -> Parser Text (Vector MsgVector)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text MsgVector -> Parser Text [MsgVector]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many1 (Parser ()
skipSpace Parser () -> Parser Text MsgVector -> Parser Text MsgVector
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text MsgVector
pVector)
        Parser Text (Vector MsgVector)
-> String -> Parser Text (Vector MsgVector)
forall i a. Parser i a -> String -> Parser i a
<?> String
"MsgVectors"

    pVector :: Parser MsgVector
    pVector :: Parser Text MsgVector
pVector = Natural -> ByteString -> ByteString -> MsgVector
MsgVector
        (Natural -> ByteString -> ByteString -> MsgVector)
-> Parser Text Natural
-> Parser Text (ByteString -> ByteString -> MsgVector)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser ()
skipSpace Parser () -> Parser Text Natural -> Parser Text Natural
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Text -> Parser Text Natural -> Parser Text Natural
forall a. Text -> Parser a -> Parser a
pEquals Text
"Len" Parser Text Natural
forall a. Integral a => Parser a
decimal)
        Parser Text (ByteString -> ByteString -> MsgVector)
-> Parser Text ByteString -> Parser Text (ByteString -> MsgVector)
forall a b. Parser Text (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ()
skipSpace Parser () -> Parser Text ByteString -> Parser Text ByteString
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Text -> Parser Text ByteString -> Parser Text ByteString
forall a. Text -> Parser a -> Parser a
pEquals Text
"Msg" Parser Text ByteString
hexbytes)
        Parser Text (ByteString -> MsgVector)
-> Parser Text ByteString -> Parser Text MsgVector
forall a b. Parser Text (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ()
skipSpace Parser () -> Parser Text ByteString -> Parser Text ByteString
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Text -> Parser Text ByteString -> Parser Text ByteString
forall a. Text -> Parser a -> Parser a
pEquals Text
"MD" Parser Text ByteString
hexbytes)
        Parser Text MsgVector -> String -> Parser Text MsgVector
forall i a. Parser i a -> String -> Parser i a
<?> String
"MsgVector"

readMsgFile :: FilePath -> IO MsgFile
readMsgFile :: String -> IO MsgFile
readMsgFile = String -> Parser MsgFile -> String -> IO MsgFile
forall a. String -> Parser a -> String -> IO a
parseFile String
"readMsgFile" Parser MsgFile
pMsgFile

embedMsgFile :: FilePath -> Code Q MsgFile
embedMsgFile :: String -> Code Q MsgFile
embedMsgFile = IO MsgFile -> Code Q MsgFile
forall a. Lift a => IO a -> Code Q a
embedIO (IO MsgFile -> Code Q MsgFile)
-> (String -> IO MsgFile) -> String -> Code Q MsgFile
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO MsgFile
readMsgFile

-- -------------------------------------------------------------------------- --
-- SHA3 Monte File

data MonteFile = MonteFile
    { MonteFile -> Text
_monteDescription :: !T.Text
    , MonteFile -> Natural
_monteL :: !Natural
    , MonteFile -> ByteString
_monteSeed :: !B.ByteString
    , MonteFile -> Vector MonteVector
_monteVectors :: !(V.Vector MonteVector)
    }
    deriving (Int -> MonteFile -> ShowS
[MonteFile] -> ShowS
MonteFile -> String
(Int -> MonteFile -> ShowS)
-> (MonteFile -> String)
-> ([MonteFile] -> ShowS)
-> Show MonteFile
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MonteFile -> ShowS
showsPrec :: Int -> MonteFile -> ShowS
$cshow :: MonteFile -> String
show :: MonteFile -> String
$cshowList :: [MonteFile] -> ShowS
showList :: [MonteFile] -> ShowS
Show, MonteFile -> MonteFile -> Bool
(MonteFile -> MonteFile -> Bool)
-> (MonteFile -> MonteFile -> Bool) -> Eq MonteFile
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MonteFile -> MonteFile -> Bool
== :: MonteFile -> MonteFile -> Bool
$c/= :: MonteFile -> MonteFile -> Bool
/= :: MonteFile -> MonteFile -> Bool
Eq, Eq MonteFile
Eq MonteFile =>
(MonteFile -> MonteFile -> Ordering)
-> (MonteFile -> MonteFile -> Bool)
-> (MonteFile -> MonteFile -> Bool)
-> (MonteFile -> MonteFile -> Bool)
-> (MonteFile -> MonteFile -> Bool)
-> (MonteFile -> MonteFile -> MonteFile)
-> (MonteFile -> MonteFile -> MonteFile)
-> Ord MonteFile
MonteFile -> MonteFile -> Bool
MonteFile -> MonteFile -> Ordering
MonteFile -> MonteFile -> MonteFile
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 :: MonteFile -> MonteFile -> Ordering
compare :: MonteFile -> MonteFile -> Ordering
$c< :: MonteFile -> MonteFile -> Bool
< :: MonteFile -> MonteFile -> Bool
$c<= :: MonteFile -> MonteFile -> Bool
<= :: MonteFile -> MonteFile -> Bool
$c> :: MonteFile -> MonteFile -> Bool
> :: MonteFile -> MonteFile -> Bool
$c>= :: MonteFile -> MonteFile -> Bool
>= :: MonteFile -> MonteFile -> Bool
$cmax :: MonteFile -> MonteFile -> MonteFile
max :: MonteFile -> MonteFile -> MonteFile
$cmin :: MonteFile -> MonteFile -> MonteFile
min :: MonteFile -> MonteFile -> MonteFile
Ord)
    deriving ((forall (m :: * -> *). Quote m => MonteFile -> m Exp)
-> (forall (m :: * -> *). Quote m => MonteFile -> Code m MonteFile)
-> Lift MonteFile
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => MonteFile -> m Exp
forall (m :: * -> *). Quote m => MonteFile -> Code m MonteFile
$clift :: forall (m :: * -> *). Quote m => MonteFile -> m Exp
lift :: forall (m :: * -> *). Quote m => MonteFile -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => MonteFile -> Code m MonteFile
liftTyped :: forall (m :: * -> *). Quote m => MonteFile -> Code m MonteFile
Lift)

data MonteVector = MonteVector
    { MonteVector -> Natural
_monteCount :: !Natural
    , MonteVector -> ByteString
_monteMd :: !B.ByteString
    }
    deriving (Int -> MonteVector -> ShowS
[MonteVector] -> ShowS
MonteVector -> String
(Int -> MonteVector -> ShowS)
-> (MonteVector -> String)
-> ([MonteVector] -> ShowS)
-> Show MonteVector
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MonteVector -> ShowS
showsPrec :: Int -> MonteVector -> ShowS
$cshow :: MonteVector -> String
show :: MonteVector -> String
$cshowList :: [MonteVector] -> ShowS
showList :: [MonteVector] -> ShowS
Show, MonteVector -> MonteVector -> Bool
(MonteVector -> MonteVector -> Bool)
-> (MonteVector -> MonteVector -> Bool) -> Eq MonteVector
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MonteVector -> MonteVector -> Bool
== :: MonteVector -> MonteVector -> Bool
$c/= :: MonteVector -> MonteVector -> Bool
/= :: MonteVector -> MonteVector -> Bool
Eq, Eq MonteVector
Eq MonteVector =>
(MonteVector -> MonteVector -> Ordering)
-> (MonteVector -> MonteVector -> Bool)
-> (MonteVector -> MonteVector -> Bool)
-> (MonteVector -> MonteVector -> Bool)
-> (MonteVector -> MonteVector -> Bool)
-> (MonteVector -> MonteVector -> MonteVector)
-> (MonteVector -> MonteVector -> MonteVector)
-> Ord MonteVector
MonteVector -> MonteVector -> Bool
MonteVector -> MonteVector -> Ordering
MonteVector -> MonteVector -> MonteVector
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 :: MonteVector -> MonteVector -> Ordering
compare :: MonteVector -> MonteVector -> Ordering
$c< :: MonteVector -> MonteVector -> Bool
< :: MonteVector -> MonteVector -> Bool
$c<= :: MonteVector -> MonteVector -> Bool
<= :: MonteVector -> MonteVector -> Bool
$c> :: MonteVector -> MonteVector -> Bool
> :: MonteVector -> MonteVector -> Bool
$c>= :: MonteVector -> MonteVector -> Bool
>= :: MonteVector -> MonteVector -> Bool
$cmax :: MonteVector -> MonteVector -> MonteVector
max :: MonteVector -> MonteVector -> MonteVector
$cmin :: MonteVector -> MonteVector -> MonteVector
min :: MonteVector -> MonteVector -> MonteVector
Ord)
    deriving ((forall (m :: * -> *). Quote m => MonteVector -> m Exp)
-> (forall (m :: * -> *).
    Quote m =>
    MonteVector -> Code m MonteVector)
-> Lift MonteVector
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => MonteVector -> m Exp
forall (m :: * -> *). Quote m => MonteVector -> Code m MonteVector
$clift :: forall (m :: * -> *). Quote m => MonteVector -> m Exp
lift :: forall (m :: * -> *). Quote m => MonteVector -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => MonteVector -> Code m MonteVector
liftTyped :: forall (m :: * -> *). Quote m => MonteVector -> Code m MonteVector
Lift)

pMonteFile :: Parser MonteFile
pMonteFile :: Parser MonteFile
pMonteFile = Text -> Natural -> ByteString -> Vector MonteVector -> MonteFile
MonteFile
    (Text -> Natural -> ByteString -> Vector MonteVector -> MonteFile)
-> Parser Text Text
-> Parser
     Text (Natural -> ByteString -> Vector MonteVector -> MonteFile)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Text
pDescription
    Parser
  Text (Natural -> ByteString -> Vector MonteVector -> MonteFile)
-> Parser Text Natural
-> Parser Text (ByteString -> Vector MonteVector -> MonteFile)
forall a b. Parser Text (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ()
skipSpace Parser () -> Parser Text Natural -> Parser Text Natural
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text Natural
pL)
    Parser Text (ByteString -> Vector MonteVector -> MonteFile)
-> Parser Text ByteString
-> Parser Text (Vector MonteVector -> MonteFile)
forall a b. Parser Text (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ()
skipSpace Parser () -> Parser Text ByteString -> Parser Text ByteString
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text ByteString
pSeed)
    Parser Text (Vector MonteVector -> MonteFile)
-> Parser Text (Vector MonteVector) -> Parser MonteFile
forall a b. Parser Text (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ()
skipSpace Parser ()
-> Parser Text (Vector MonteVector)
-> Parser Text (Vector MonteVector)
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text (Vector MonteVector)
pVectors)
    Parser MonteFile -> Parser () -> Parser MonteFile
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (Parser ()
skipSpace Parser () -> Parser () -> Parser ()
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
forall t. Chunk t => Parser t ()
endOfInput)
    Parser MonteFile -> String -> Parser MonteFile
forall i a. Parser i a -> String -> Parser i a
<?> String
"RspMonteFile"
  where
    pSeed :: Parser B.ByteString
    pSeed :: Parser Text ByteString
pSeed = Text -> Parser Text ByteString -> Parser Text ByteString
forall a. Text -> Parser a -> Parser a
pEquals Text
"Seed" Parser Text ByteString
hexbytes Parser Text ByteString -> String -> Parser Text ByteString
forall i a. Parser i a -> String -> Parser i a
<?> String
"Seed"

    pVectors :: Parser (V.Vector MonteVector)
    pVectors :: Parser Text (Vector MonteVector)
pVectors = [MonteVector] -> Vector MonteVector
forall a. [a] -> Vector a
V.fromList
        ([MonteVector] -> Vector MonteVector)
-> Parser Text [MonteVector] -> Parser Text (Vector MonteVector)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text MonteVector -> Parser Text [MonteVector]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many1 (Parser ()
skipSpace Parser () -> Parser Text MonteVector -> Parser Text MonteVector
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text MonteVector
pVector)
        Parser Text (Vector MonteVector)
-> String -> Parser Text (Vector MonteVector)
forall i a. Parser i a -> String -> Parser i a
<?> String
"MonteVectors"

    pVector :: Parser MonteVector
    pVector :: Parser Text MonteVector
pVector = Natural -> ByteString -> MonteVector
MonteVector
        (Natural -> ByteString -> MonteVector)
-> Parser Text Natural -> Parser Text (ByteString -> MonteVector)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser ()
skipSpace Parser () -> Parser Text Natural -> Parser Text Natural
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Text -> Parser Text Natural -> Parser Text Natural
forall a. Text -> Parser a -> Parser a
pEquals Text
"COUNT" Parser Text Natural
forall a. Integral a => Parser a
decimal)
        Parser Text (ByteString -> MonteVector)
-> Parser Text ByteString -> Parser Text MonteVector
forall a b. Parser Text (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ()
skipSpace Parser () -> Parser Text ByteString -> Parser Text ByteString
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Text -> Parser Text ByteString -> Parser Text ByteString
forall a. Text -> Parser a -> Parser a
pEquals Text
"MD" Parser Text ByteString
hexbytes)
        Parser Text MonteVector -> String -> Parser Text MonteVector
forall i a. Parser i a -> String -> Parser i a
<?> String
"MonteVector"

readMonteFile :: FilePath -> IO MonteFile
readMonteFile :: String -> IO MonteFile
readMonteFile = String -> Parser MonteFile -> String -> IO MonteFile
forall a. String -> Parser a -> String -> IO a
parseFile String
"readMonteFile" Parser MonteFile
pMonteFile

embedMonteFile :: FilePath -> Code Q MonteFile
embedMonteFile :: String -> Code Q MonteFile
embedMonteFile = IO MonteFile -> Code Q MonteFile
forall a. Lift a => IO a -> Code Q a
embedIO (IO MonteFile -> Code Q MonteFile)
-> (String -> IO MonteFile) -> String -> Code Q MonteFile
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO MonteFile
readMonteFile

-- -------------------------------------------------------------------------- --
-- Shake Msg File

data ShakeMsgFile = ShakeMsgFile
    { ShakeMsgFile -> Text
_shakeMsgDescription :: !T.Text
    , ShakeMsgFile -> Natural
_shakeMsgOutputLen:: !Natural
    , ShakeMsgFile -> Vector MsgVector
_shakeMsgVectors :: !(V.Vector MsgVector)
    }
    deriving (Int -> ShakeMsgFile -> ShowS
[ShakeMsgFile] -> ShowS
ShakeMsgFile -> String
(Int -> ShakeMsgFile -> ShowS)
-> (ShakeMsgFile -> String)
-> ([ShakeMsgFile] -> ShowS)
-> Show ShakeMsgFile
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ShakeMsgFile -> ShowS
showsPrec :: Int -> ShakeMsgFile -> ShowS
$cshow :: ShakeMsgFile -> String
show :: ShakeMsgFile -> String
$cshowList :: [ShakeMsgFile] -> ShowS
showList :: [ShakeMsgFile] -> ShowS
Show, ShakeMsgFile -> ShakeMsgFile -> Bool
(ShakeMsgFile -> ShakeMsgFile -> Bool)
-> (ShakeMsgFile -> ShakeMsgFile -> Bool) -> Eq ShakeMsgFile
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ShakeMsgFile -> ShakeMsgFile -> Bool
== :: ShakeMsgFile -> ShakeMsgFile -> Bool
$c/= :: ShakeMsgFile -> ShakeMsgFile -> Bool
/= :: ShakeMsgFile -> ShakeMsgFile -> Bool
Eq, Eq ShakeMsgFile
Eq ShakeMsgFile =>
(ShakeMsgFile -> ShakeMsgFile -> Ordering)
-> (ShakeMsgFile -> ShakeMsgFile -> Bool)
-> (ShakeMsgFile -> ShakeMsgFile -> Bool)
-> (ShakeMsgFile -> ShakeMsgFile -> Bool)
-> (ShakeMsgFile -> ShakeMsgFile -> Bool)
-> (ShakeMsgFile -> ShakeMsgFile -> ShakeMsgFile)
-> (ShakeMsgFile -> ShakeMsgFile -> ShakeMsgFile)
-> Ord ShakeMsgFile
ShakeMsgFile -> ShakeMsgFile -> Bool
ShakeMsgFile -> ShakeMsgFile -> Ordering
ShakeMsgFile -> ShakeMsgFile -> ShakeMsgFile
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 :: ShakeMsgFile -> ShakeMsgFile -> Ordering
compare :: ShakeMsgFile -> ShakeMsgFile -> Ordering
$c< :: ShakeMsgFile -> ShakeMsgFile -> Bool
< :: ShakeMsgFile -> ShakeMsgFile -> Bool
$c<= :: ShakeMsgFile -> ShakeMsgFile -> Bool
<= :: ShakeMsgFile -> ShakeMsgFile -> Bool
$c> :: ShakeMsgFile -> ShakeMsgFile -> Bool
> :: ShakeMsgFile -> ShakeMsgFile -> Bool
$c>= :: ShakeMsgFile -> ShakeMsgFile -> Bool
>= :: ShakeMsgFile -> ShakeMsgFile -> Bool
$cmax :: ShakeMsgFile -> ShakeMsgFile -> ShakeMsgFile
max :: ShakeMsgFile -> ShakeMsgFile -> ShakeMsgFile
$cmin :: ShakeMsgFile -> ShakeMsgFile -> ShakeMsgFile
min :: ShakeMsgFile -> ShakeMsgFile -> ShakeMsgFile
Ord)
    deriving ((forall (m :: * -> *). Quote m => ShakeMsgFile -> m Exp)
-> (forall (m :: * -> *).
    Quote m =>
    ShakeMsgFile -> Code m ShakeMsgFile)
-> Lift ShakeMsgFile
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => ShakeMsgFile -> m Exp
forall (m :: * -> *).
Quote m =>
ShakeMsgFile -> Code m ShakeMsgFile
$clift :: forall (m :: * -> *). Quote m => ShakeMsgFile -> m Exp
lift :: forall (m :: * -> *). Quote m => ShakeMsgFile -> m Exp
$cliftTyped :: forall (m :: * -> *).
Quote m =>
ShakeMsgFile -> Code m ShakeMsgFile
liftTyped :: forall (m :: * -> *).
Quote m =>
ShakeMsgFile -> Code m ShakeMsgFile
Lift)

data ShakeMsgVector = ShakeMsgVector
    { ShakeMsgVector -> Natural
_shakeMsgLen :: !Natural
    , ShakeMsgVector -> ByteString
_shakeMsgMsg :: !B.ByteString
    , ShakeMsgVector -> ByteString
_shakeMsgOutput :: !B.ByteString
    }
    deriving (Int -> ShakeMsgVector -> ShowS
[ShakeMsgVector] -> ShowS
ShakeMsgVector -> String
(Int -> ShakeMsgVector -> ShowS)
-> (ShakeMsgVector -> String)
-> ([ShakeMsgVector] -> ShowS)
-> Show ShakeMsgVector
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ShakeMsgVector -> ShowS
showsPrec :: Int -> ShakeMsgVector -> ShowS
$cshow :: ShakeMsgVector -> String
show :: ShakeMsgVector -> String
$cshowList :: [ShakeMsgVector] -> ShowS
showList :: [ShakeMsgVector] -> ShowS
Show, ShakeMsgVector -> ShakeMsgVector -> Bool
(ShakeMsgVector -> ShakeMsgVector -> Bool)
-> (ShakeMsgVector -> ShakeMsgVector -> Bool) -> Eq ShakeMsgVector
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ShakeMsgVector -> ShakeMsgVector -> Bool
== :: ShakeMsgVector -> ShakeMsgVector -> Bool
$c/= :: ShakeMsgVector -> ShakeMsgVector -> Bool
/= :: ShakeMsgVector -> ShakeMsgVector -> Bool
Eq, Eq ShakeMsgVector
Eq ShakeMsgVector =>
(ShakeMsgVector -> ShakeMsgVector -> Ordering)
-> (ShakeMsgVector -> ShakeMsgVector -> Bool)
-> (ShakeMsgVector -> ShakeMsgVector -> Bool)
-> (ShakeMsgVector -> ShakeMsgVector -> Bool)
-> (ShakeMsgVector -> ShakeMsgVector -> Bool)
-> (ShakeMsgVector -> ShakeMsgVector -> ShakeMsgVector)
-> (ShakeMsgVector -> ShakeMsgVector -> ShakeMsgVector)
-> Ord ShakeMsgVector
ShakeMsgVector -> ShakeMsgVector -> Bool
ShakeMsgVector -> ShakeMsgVector -> Ordering
ShakeMsgVector -> ShakeMsgVector -> ShakeMsgVector
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 :: ShakeMsgVector -> ShakeMsgVector -> Ordering
compare :: ShakeMsgVector -> ShakeMsgVector -> Ordering
$c< :: ShakeMsgVector -> ShakeMsgVector -> Bool
< :: ShakeMsgVector -> ShakeMsgVector -> Bool
$c<= :: ShakeMsgVector -> ShakeMsgVector -> Bool
<= :: ShakeMsgVector -> ShakeMsgVector -> Bool
$c> :: ShakeMsgVector -> ShakeMsgVector -> Bool
> :: ShakeMsgVector -> ShakeMsgVector -> Bool
$c>= :: ShakeMsgVector -> ShakeMsgVector -> Bool
>= :: ShakeMsgVector -> ShakeMsgVector -> Bool
$cmax :: ShakeMsgVector -> ShakeMsgVector -> ShakeMsgVector
max :: ShakeMsgVector -> ShakeMsgVector -> ShakeMsgVector
$cmin :: ShakeMsgVector -> ShakeMsgVector -> ShakeMsgVector
min :: ShakeMsgVector -> ShakeMsgVector -> ShakeMsgVector
Ord)
    deriving ((forall (m :: * -> *). Quote m => ShakeMsgVector -> m Exp)
-> (forall (m :: * -> *).
    Quote m =>
    ShakeMsgVector -> Code m ShakeMsgVector)
-> Lift ShakeMsgVector
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => ShakeMsgVector -> m Exp
forall (m :: * -> *).
Quote m =>
ShakeMsgVector -> Code m ShakeMsgVector
$clift :: forall (m :: * -> *). Quote m => ShakeMsgVector -> m Exp
lift :: forall (m :: * -> *). Quote m => ShakeMsgVector -> m Exp
$cliftTyped :: forall (m :: * -> *).
Quote m =>
ShakeMsgVector -> Code m ShakeMsgVector
liftTyped :: forall (m :: * -> *).
Quote m =>
ShakeMsgVector -> Code m ShakeMsgVector
Lift)

pShakeMsgFile :: Parser ShakeMsgFile
pShakeMsgFile :: Parser ShakeMsgFile
pShakeMsgFile = Text -> Natural -> Vector MsgVector -> ShakeMsgFile
ShakeMsgFile
    (Text -> Natural -> Vector MsgVector -> ShakeMsgFile)
-> Parser Text Text
-> Parser Text (Natural -> Vector MsgVector -> ShakeMsgFile)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Text
pDescription
    Parser Text (Natural -> Vector MsgVector -> ShakeMsgFile)
-> Parser Text Natural
-> Parser Text (Vector MsgVector -> ShakeMsgFile)
forall a b. Parser Text (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ()
skipSpace Parser () -> Parser Text Natural -> Parser Text Natural
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text Natural
pOutputLength)
    Parser Text (Vector MsgVector -> ShakeMsgFile)
-> Parser Text (Vector MsgVector) -> Parser ShakeMsgFile
forall a b. Parser Text (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ()
skipSpace Parser ()
-> Parser Text (Vector MsgVector) -> Parser Text (Vector MsgVector)
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text (Vector MsgVector)
pVectors)
    Parser ShakeMsgFile -> Parser () -> Parser ShakeMsgFile
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (Parser ()
skipSpace Parser () -> Parser () -> Parser ()
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
forall t. Chunk t => Parser t ()
endOfInput)
    Parser ShakeMsgFile -> String -> Parser ShakeMsgFile
forall i a. Parser i a -> String -> Parser i a
<?> String
"RspMsgFile"
  where
    pOutputLength :: Parser Natural
    pOutputLength :: Parser Text Natural
pOutputLength = Parser Text Natural -> Parser Text Natural
forall a. Parser a -> Parser a
pInBrackets (Text -> Parser Text Natural -> Parser Text Natural
forall a. Text -> Parser a -> Parser a
pEquals Text
"Outputlen" Parser Text Natural
forall a. Integral a => Parser a
decimal)
        Parser Text Natural -> String -> Parser Text Natural
forall i a. Parser i a -> String -> Parser i a
<?> String
"Outputlen"

    pVectors :: Parser (V.Vector MsgVector)
    pVectors :: Parser Text (Vector MsgVector)
pVectors = [MsgVector] -> Vector MsgVector
forall a. [a] -> Vector a
V.fromList
        ([MsgVector] -> Vector MsgVector)
-> Parser Text [MsgVector] -> Parser Text (Vector MsgVector)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text MsgVector -> Parser Text [MsgVector]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many1 (Parser ()
skipSpace Parser () -> Parser Text MsgVector -> Parser Text MsgVector
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text MsgVector
pVector)
        Parser Text (Vector MsgVector)
-> String -> Parser Text (Vector MsgVector)
forall i a. Parser i a -> String -> Parser i a
<?> String
"MsgVectors"

    pVector :: Parser MsgVector
    pVector :: Parser Text MsgVector
pVector = Natural -> ByteString -> ByteString -> MsgVector
MsgVector
        (Natural -> ByteString -> ByteString -> MsgVector)
-> Parser Text Natural
-> Parser Text (ByteString -> ByteString -> MsgVector)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser ()
skipSpace Parser () -> Parser Text Natural -> Parser Text Natural
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Text -> Parser Text Natural -> Parser Text Natural
forall a. Text -> Parser a -> Parser a
pEquals Text
"Len" Parser Text Natural
forall a. Integral a => Parser a
decimal)
        Parser Text (ByteString -> ByteString -> MsgVector)
-> Parser Text ByteString -> Parser Text (ByteString -> MsgVector)
forall a b. Parser Text (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ()
skipSpace Parser () -> Parser Text ByteString -> Parser Text ByteString
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Text -> Parser Text ByteString -> Parser Text ByteString
forall a. Text -> Parser a -> Parser a
pEquals Text
"Msg" Parser Text ByteString
hexbytes)
        Parser Text (ByteString -> MsgVector)
-> Parser Text ByteString -> Parser Text MsgVector
forall a b. Parser Text (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ()
skipSpace Parser () -> Parser Text ByteString -> Parser Text ByteString
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Text -> Parser Text ByteString -> Parser Text ByteString
forall a. Text -> Parser a -> Parser a
pEquals Text
"Output" Parser Text ByteString
hexbytes)
        Parser Text MsgVector -> String -> Parser Text MsgVector
forall i a. Parser i a -> String -> Parser i a
<?> String
"MsgVector"

readShakeMsgFile :: FilePath -> IO ShakeMsgFile
readShakeMsgFile :: String -> IO ShakeMsgFile
readShakeMsgFile = String -> Parser ShakeMsgFile -> String -> IO ShakeMsgFile
forall a. String -> Parser a -> String -> IO a
parseFile String
"readShakeMsgFile" Parser ShakeMsgFile
pShakeMsgFile

embedShakeMsgFile :: FilePath -> Code Q ShakeMsgFile
embedShakeMsgFile :: String -> Code Q ShakeMsgFile
embedShakeMsgFile = IO ShakeMsgFile -> Code Q ShakeMsgFile
forall a. Lift a => IO a -> Code Q a
embedIO (IO ShakeMsgFile -> Code Q ShakeMsgFile)
-> (String -> IO ShakeMsgFile) -> String -> Code Q ShakeMsgFile
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ShakeMsgFile
readShakeMsgFile

-- -------------------------------------------------------------------------- --
-- SHAKE Monte File

data ShakeMonteFile = ShakeMonteFile
    { ShakeMonteFile -> Text
_shakeMonteDescription :: !T.Text
    , ShakeMonteFile -> Natural
_shakeMonteMinOutputBits :: !Natural
    , ShakeMonteFile -> Natural
_shakeMonteMaxOutputBits :: !Natural
    , ShakeMonteFile -> ByteString
_shakeMonteMsg :: !B.ByteString
    , ShakeMonteFile -> Vector ShakeMonteVector
_shakeMonteVectors :: !(V.Vector ShakeMonteVector)
    }
    deriving (Int -> ShakeMonteFile -> ShowS
[ShakeMonteFile] -> ShowS
ShakeMonteFile -> String
(Int -> ShakeMonteFile -> ShowS)
-> (ShakeMonteFile -> String)
-> ([ShakeMonteFile] -> ShowS)
-> Show ShakeMonteFile
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ShakeMonteFile -> ShowS
showsPrec :: Int -> ShakeMonteFile -> ShowS
$cshow :: ShakeMonteFile -> String
show :: ShakeMonteFile -> String
$cshowList :: [ShakeMonteFile] -> ShowS
showList :: [ShakeMonteFile] -> ShowS
Show, ShakeMonteFile -> ShakeMonteFile -> Bool
(ShakeMonteFile -> ShakeMonteFile -> Bool)
-> (ShakeMonteFile -> ShakeMonteFile -> Bool) -> Eq ShakeMonteFile
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ShakeMonteFile -> ShakeMonteFile -> Bool
== :: ShakeMonteFile -> ShakeMonteFile -> Bool
$c/= :: ShakeMonteFile -> ShakeMonteFile -> Bool
/= :: ShakeMonteFile -> ShakeMonteFile -> Bool
Eq, Eq ShakeMonteFile
Eq ShakeMonteFile =>
(ShakeMonteFile -> ShakeMonteFile -> Ordering)
-> (ShakeMonteFile -> ShakeMonteFile -> Bool)
-> (ShakeMonteFile -> ShakeMonteFile -> Bool)
-> (ShakeMonteFile -> ShakeMonteFile -> Bool)
-> (ShakeMonteFile -> ShakeMonteFile -> Bool)
-> (ShakeMonteFile -> ShakeMonteFile -> ShakeMonteFile)
-> (ShakeMonteFile -> ShakeMonteFile -> ShakeMonteFile)
-> Ord ShakeMonteFile
ShakeMonteFile -> ShakeMonteFile -> Bool
ShakeMonteFile -> ShakeMonteFile -> Ordering
ShakeMonteFile -> ShakeMonteFile -> ShakeMonteFile
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 :: ShakeMonteFile -> ShakeMonteFile -> Ordering
compare :: ShakeMonteFile -> ShakeMonteFile -> Ordering
$c< :: ShakeMonteFile -> ShakeMonteFile -> Bool
< :: ShakeMonteFile -> ShakeMonteFile -> Bool
$c<= :: ShakeMonteFile -> ShakeMonteFile -> Bool
<= :: ShakeMonteFile -> ShakeMonteFile -> Bool
$c> :: ShakeMonteFile -> ShakeMonteFile -> Bool
> :: ShakeMonteFile -> ShakeMonteFile -> Bool
$c>= :: ShakeMonteFile -> ShakeMonteFile -> Bool
>= :: ShakeMonteFile -> ShakeMonteFile -> Bool
$cmax :: ShakeMonteFile -> ShakeMonteFile -> ShakeMonteFile
max :: ShakeMonteFile -> ShakeMonteFile -> ShakeMonteFile
$cmin :: ShakeMonteFile -> ShakeMonteFile -> ShakeMonteFile
min :: ShakeMonteFile -> ShakeMonteFile -> ShakeMonteFile
Ord)
    deriving ((forall (m :: * -> *). Quote m => ShakeMonteFile -> m Exp)
-> (forall (m :: * -> *).
    Quote m =>
    ShakeMonteFile -> Code m ShakeMonteFile)
-> Lift ShakeMonteFile
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => ShakeMonteFile -> m Exp
forall (m :: * -> *).
Quote m =>
ShakeMonteFile -> Code m ShakeMonteFile
$clift :: forall (m :: * -> *). Quote m => ShakeMonteFile -> m Exp
lift :: forall (m :: * -> *). Quote m => ShakeMonteFile -> m Exp
$cliftTyped :: forall (m :: * -> *).
Quote m =>
ShakeMonteFile -> Code m ShakeMonteFile
liftTyped :: forall (m :: * -> *).
Quote m =>
ShakeMonteFile -> Code m ShakeMonteFile
Lift)

data ShakeMonteVector = ShakeMonteVector
    { ShakeMonteVector -> Natural
_shakeMonteCount :: !Natural
    , ShakeMonteVector -> Natural
_shakeMonteOutputLen :: !Natural
    , ShakeMonteVector -> ByteString
_shakeMonteOutput :: !B.ByteString
    }
    deriving (Int -> ShakeMonteVector -> ShowS
[ShakeMonteVector] -> ShowS
ShakeMonteVector -> String
(Int -> ShakeMonteVector -> ShowS)
-> (ShakeMonteVector -> String)
-> ([ShakeMonteVector] -> ShowS)
-> Show ShakeMonteVector
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ShakeMonteVector -> ShowS
showsPrec :: Int -> ShakeMonteVector -> ShowS
$cshow :: ShakeMonteVector -> String
show :: ShakeMonteVector -> String
$cshowList :: [ShakeMonteVector] -> ShowS
showList :: [ShakeMonteVector] -> ShowS
Show, ShakeMonteVector -> ShakeMonteVector -> Bool
(ShakeMonteVector -> ShakeMonteVector -> Bool)
-> (ShakeMonteVector -> ShakeMonteVector -> Bool)
-> Eq ShakeMonteVector
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ShakeMonteVector -> ShakeMonteVector -> Bool
== :: ShakeMonteVector -> ShakeMonteVector -> Bool
$c/= :: ShakeMonteVector -> ShakeMonteVector -> Bool
/= :: ShakeMonteVector -> ShakeMonteVector -> Bool
Eq, Eq ShakeMonteVector
Eq ShakeMonteVector =>
(ShakeMonteVector -> ShakeMonteVector -> Ordering)
-> (ShakeMonteVector -> ShakeMonteVector -> Bool)
-> (ShakeMonteVector -> ShakeMonteVector -> Bool)
-> (ShakeMonteVector -> ShakeMonteVector -> Bool)
-> (ShakeMonteVector -> ShakeMonteVector -> Bool)
-> (ShakeMonteVector -> ShakeMonteVector -> ShakeMonteVector)
-> (ShakeMonteVector -> ShakeMonteVector -> ShakeMonteVector)
-> Ord ShakeMonteVector
ShakeMonteVector -> ShakeMonteVector -> Bool
ShakeMonteVector -> ShakeMonteVector -> Ordering
ShakeMonteVector -> ShakeMonteVector -> ShakeMonteVector
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 :: ShakeMonteVector -> ShakeMonteVector -> Ordering
compare :: ShakeMonteVector -> ShakeMonteVector -> Ordering
$c< :: ShakeMonteVector -> ShakeMonteVector -> Bool
< :: ShakeMonteVector -> ShakeMonteVector -> Bool
$c<= :: ShakeMonteVector -> ShakeMonteVector -> Bool
<= :: ShakeMonteVector -> ShakeMonteVector -> Bool
$c> :: ShakeMonteVector -> ShakeMonteVector -> Bool
> :: ShakeMonteVector -> ShakeMonteVector -> Bool
$c>= :: ShakeMonteVector -> ShakeMonteVector -> Bool
>= :: ShakeMonteVector -> ShakeMonteVector -> Bool
$cmax :: ShakeMonteVector -> ShakeMonteVector -> ShakeMonteVector
max :: ShakeMonteVector -> ShakeMonteVector -> ShakeMonteVector
$cmin :: ShakeMonteVector -> ShakeMonteVector -> ShakeMonteVector
min :: ShakeMonteVector -> ShakeMonteVector -> ShakeMonteVector
Ord)
    deriving ((forall (m :: * -> *). Quote m => ShakeMonteVector -> m Exp)
-> (forall (m :: * -> *).
    Quote m =>
    ShakeMonteVector -> Code m ShakeMonteVector)
-> Lift ShakeMonteVector
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => ShakeMonteVector -> m Exp
forall (m :: * -> *).
Quote m =>
ShakeMonteVector -> Code m ShakeMonteVector
$clift :: forall (m :: * -> *). Quote m => ShakeMonteVector -> m Exp
lift :: forall (m :: * -> *). Quote m => ShakeMonteVector -> m Exp
$cliftTyped :: forall (m :: * -> *).
Quote m =>
ShakeMonteVector -> Code m ShakeMonteVector
liftTyped :: forall (m :: * -> *).
Quote m =>
ShakeMonteVector -> Code m ShakeMonteVector
Lift)

pShakeMonteFile :: Parser ShakeMonteFile
pShakeMonteFile :: Parser ShakeMonteFile
pShakeMonteFile = Text
-> Natural
-> Natural
-> ByteString
-> Vector ShakeMonteVector
-> ShakeMonteFile
ShakeMonteFile
    (Text
 -> Natural
 -> Natural
 -> ByteString
 -> Vector ShakeMonteVector
 -> ShakeMonteFile)
-> Parser Text Text
-> Parser
     Text
     (Natural
      -> Natural
      -> ByteString
      -> Vector ShakeMonteVector
      -> ShakeMonteFile)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Text
pDescription
    Parser
  Text
  (Natural
   -> Natural
   -> ByteString
   -> Vector ShakeMonteVector
   -> ShakeMonteFile)
-> Parser Text Natural
-> Parser
     Text
     (Natural
      -> ByteString -> Vector ShakeMonteVector -> ShakeMonteFile)
forall a b. Parser Text (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ()
skipSpace Parser () -> Parser Text Natural -> Parser Text Natural
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text Natural
pMinOutput)
    Parser
  Text
  (Natural
   -> ByteString -> Vector ShakeMonteVector -> ShakeMonteFile)
-> Parser Text Natural
-> Parser
     Text (ByteString -> Vector ShakeMonteVector -> ShakeMonteFile)
forall a b. Parser Text (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ()
skipSpace Parser () -> Parser Text Natural -> Parser Text Natural
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text Natural
pMaxOutput)
    Parser
  Text (ByteString -> Vector ShakeMonteVector -> ShakeMonteFile)
-> Parser Text ByteString
-> Parser Text (Vector ShakeMonteVector -> ShakeMonteFile)
forall a b. Parser Text (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ()
skipSpace Parser () -> Parser Text ByteString -> Parser Text ByteString
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text ByteString
pMsg)
    Parser Text (Vector ShakeMonteVector -> ShakeMonteFile)
-> Parser Text (Vector ShakeMonteVector) -> Parser ShakeMonteFile
forall a b. Parser Text (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ()
skipSpace Parser ()
-> Parser Text (Vector ShakeMonteVector)
-> Parser Text (Vector ShakeMonteVector)
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text (Vector ShakeMonteVector)
pVectors)
    Parser ShakeMonteFile -> Parser () -> Parser ShakeMonteFile
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (Parser ()
skipSpace Parser () -> Parser () -> Parser ()
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
forall t. Chunk t => Parser t ()
endOfInput)
    Parser ShakeMonteFile -> String -> Parser ShakeMonteFile
forall i a. Parser i a -> String -> Parser i a
<?> String
"RspMonteFile"
  where
    pMinOutput :: Parser Natural
    pMinOutput :: Parser Text Natural
pMinOutput = Parser Text Natural -> Parser Text Natural
forall a. Parser a -> Parser a
pInBrackets (Text -> Parser Text Natural -> Parser Text Natural
forall a. Text -> Parser a -> Parser a
pEquals Text
"Minimum Output Length (bits)" Parser Text Natural
forall a. Integral a => Parser a
decimal)
        Parser Text Natural -> String -> Parser Text Natural
forall i a. Parser i a -> String -> Parser i a
<?> String
"MinOutput"

    pMaxOutput :: Parser Natural
    pMaxOutput :: Parser Text Natural
pMaxOutput = Parser Text Natural -> Parser Text Natural
forall a. Parser a -> Parser a
pInBrackets (Text -> Parser Text Natural -> Parser Text Natural
forall a. Text -> Parser a -> Parser a
pEquals Text
"Maximum Output Length (bits)" Parser Text Natural
forall a. Integral a => Parser a
decimal)
        Parser Text Natural -> String -> Parser Text Natural
forall i a. Parser i a -> String -> Parser i a
<?> String
"MaxOutput"

    pMsg :: Parser B.ByteString
    pMsg :: Parser Text ByteString
pMsg = Text -> Parser Text ByteString -> Parser Text ByteString
forall a. Text -> Parser a -> Parser a
pEquals Text
"Msg" Parser Text ByteString
hexbytes Parser Text ByteString -> String -> Parser Text ByteString
forall i a. Parser i a -> String -> Parser i a
<?> String
"Msg"

    pVectors :: Parser (V.Vector ShakeMonteVector)
    pVectors :: Parser Text (Vector ShakeMonteVector)
pVectors = [ShakeMonteVector] -> Vector ShakeMonteVector
forall a. [a] -> Vector a
V.fromList
        ([ShakeMonteVector] -> Vector ShakeMonteVector)
-> Parser Text [ShakeMonteVector]
-> Parser Text (Vector ShakeMonteVector)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text ShakeMonteVector -> Parser Text [ShakeMonteVector]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many1 (Parser ()
skipSpace Parser ()
-> Parser Text ShakeMonteVector -> Parser Text ShakeMonteVector
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text ShakeMonteVector
pVector)
        Parser Text (Vector ShakeMonteVector)
-> String -> Parser Text (Vector ShakeMonteVector)
forall i a. Parser i a -> String -> Parser i a
<?> String
"ShakeMonteVectors"

    pVector :: Parser ShakeMonteVector
    pVector :: Parser Text ShakeMonteVector
pVector = Natural -> Natural -> ByteString -> ShakeMonteVector
ShakeMonteVector
        (Natural -> Natural -> ByteString -> ShakeMonteVector)
-> Parser Text Natural
-> Parser Text (Natural -> ByteString -> ShakeMonteVector)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser ()
skipSpace Parser () -> Parser Text Natural -> Parser Text Natural
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Text -> Parser Text Natural -> Parser Text Natural
forall a. Text -> Parser a -> Parser a
pEquals Text
"COUNT" Parser Text Natural
forall a. Integral a => Parser a
decimal)
        Parser Text (Natural -> ByteString -> ShakeMonteVector)
-> Parser Text Natural
-> Parser Text (ByteString -> ShakeMonteVector)
forall a b. Parser Text (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ()
skipSpace Parser () -> Parser Text Natural -> Parser Text Natural
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Text -> Parser Text Natural -> Parser Text Natural
forall a. Text -> Parser a -> Parser a
pEquals Text
"Outputlen" Parser Text Natural
forall a. Integral a => Parser a
decimal)
        Parser Text (ByteString -> ShakeMonteVector)
-> Parser Text ByteString -> Parser Text ShakeMonteVector
forall a b. Parser Text (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ()
skipSpace Parser () -> Parser Text ByteString -> Parser Text ByteString
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Text -> Parser Text ByteString -> Parser Text ByteString
forall a. Text -> Parser a -> Parser a
pEquals Text
"Output" Parser Text ByteString
hexbytes)
        Parser Text ShakeMonteVector
-> String -> Parser Text ShakeMonteVector
forall i a. Parser i a -> String -> Parser i a
<?> String
"ShakeMonteVector"

readShakeMonteFile :: FilePath -> IO ShakeMonteFile
readShakeMonteFile :: String -> IO ShakeMonteFile
readShakeMonteFile = String -> Parser ShakeMonteFile -> String -> IO ShakeMonteFile
forall a. String -> Parser a -> String -> IO a
parseFile String
"readShakeMonteFile" Parser ShakeMonteFile
pShakeMonteFile

embedShakeMonteFile :: FilePath -> Code Q ShakeMonteFile
embedShakeMonteFile :: String -> Code Q ShakeMonteFile
embedShakeMonteFile = IO ShakeMonteFile -> Code Q ShakeMonteFile
forall a. Lift a => IO a -> Code Q a
embedIO (IO ShakeMonteFile -> Code Q ShakeMonteFile)
-> (String -> IO ShakeMonteFile) -> String -> Code Q ShakeMonteFile
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ShakeMonteFile
readShakeMonteFile

-- -------------------------------------------------------------------------- --
-- SHAKE Variable Out File

data ShakeVarOutFile = ShakeVarOutFile
    { ShakeVarOutFile -> Text
_shakeVarOutDescription :: !T.Text
    , ShakeVarOutFile -> Natural
_shakeVarOutInputLength :: !Natural
    , ShakeVarOutFile -> Natural
_shakeVarOutMinOutputBits :: !Natural
    , ShakeVarOutFile -> Natural
_shakeVarOutMaxOutputBits :: !Natural
    , ShakeVarOutFile -> Vector ShakeVarOutVector
_shakeVarOutVectors :: !(V.Vector ShakeVarOutVector)
    }
    deriving (Int -> ShakeVarOutFile -> ShowS
[ShakeVarOutFile] -> ShowS
ShakeVarOutFile -> String
(Int -> ShakeVarOutFile -> ShowS)
-> (ShakeVarOutFile -> String)
-> ([ShakeVarOutFile] -> ShowS)
-> Show ShakeVarOutFile
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ShakeVarOutFile -> ShowS
showsPrec :: Int -> ShakeVarOutFile -> ShowS
$cshow :: ShakeVarOutFile -> String
show :: ShakeVarOutFile -> String
$cshowList :: [ShakeVarOutFile] -> ShowS
showList :: [ShakeVarOutFile] -> ShowS
Show, ShakeVarOutFile -> ShakeVarOutFile -> Bool
(ShakeVarOutFile -> ShakeVarOutFile -> Bool)
-> (ShakeVarOutFile -> ShakeVarOutFile -> Bool)
-> Eq ShakeVarOutFile
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ShakeVarOutFile -> ShakeVarOutFile -> Bool
== :: ShakeVarOutFile -> ShakeVarOutFile -> Bool
$c/= :: ShakeVarOutFile -> ShakeVarOutFile -> Bool
/= :: ShakeVarOutFile -> ShakeVarOutFile -> Bool
Eq, Eq ShakeVarOutFile
Eq ShakeVarOutFile =>
(ShakeVarOutFile -> ShakeVarOutFile -> Ordering)
-> (ShakeVarOutFile -> ShakeVarOutFile -> Bool)
-> (ShakeVarOutFile -> ShakeVarOutFile -> Bool)
-> (ShakeVarOutFile -> ShakeVarOutFile -> Bool)
-> (ShakeVarOutFile -> ShakeVarOutFile -> Bool)
-> (ShakeVarOutFile -> ShakeVarOutFile -> ShakeVarOutFile)
-> (ShakeVarOutFile -> ShakeVarOutFile -> ShakeVarOutFile)
-> Ord ShakeVarOutFile
ShakeVarOutFile -> ShakeVarOutFile -> Bool
ShakeVarOutFile -> ShakeVarOutFile -> Ordering
ShakeVarOutFile -> ShakeVarOutFile -> ShakeVarOutFile
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 :: ShakeVarOutFile -> ShakeVarOutFile -> Ordering
compare :: ShakeVarOutFile -> ShakeVarOutFile -> Ordering
$c< :: ShakeVarOutFile -> ShakeVarOutFile -> Bool
< :: ShakeVarOutFile -> ShakeVarOutFile -> Bool
$c<= :: ShakeVarOutFile -> ShakeVarOutFile -> Bool
<= :: ShakeVarOutFile -> ShakeVarOutFile -> Bool
$c> :: ShakeVarOutFile -> ShakeVarOutFile -> Bool
> :: ShakeVarOutFile -> ShakeVarOutFile -> Bool
$c>= :: ShakeVarOutFile -> ShakeVarOutFile -> Bool
>= :: ShakeVarOutFile -> ShakeVarOutFile -> Bool
$cmax :: ShakeVarOutFile -> ShakeVarOutFile -> ShakeVarOutFile
max :: ShakeVarOutFile -> ShakeVarOutFile -> ShakeVarOutFile
$cmin :: ShakeVarOutFile -> ShakeVarOutFile -> ShakeVarOutFile
min :: ShakeVarOutFile -> ShakeVarOutFile -> ShakeVarOutFile
Ord)
    deriving ((forall (m :: * -> *). Quote m => ShakeVarOutFile -> m Exp)
-> (forall (m :: * -> *).
    Quote m =>
    ShakeVarOutFile -> Code m ShakeVarOutFile)
-> Lift ShakeVarOutFile
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => ShakeVarOutFile -> m Exp
forall (m :: * -> *).
Quote m =>
ShakeVarOutFile -> Code m ShakeVarOutFile
$clift :: forall (m :: * -> *). Quote m => ShakeVarOutFile -> m Exp
lift :: forall (m :: * -> *). Quote m => ShakeVarOutFile -> m Exp
$cliftTyped :: forall (m :: * -> *).
Quote m =>
ShakeVarOutFile -> Code m ShakeVarOutFile
liftTyped :: forall (m :: * -> *).
Quote m =>
ShakeVarOutFile -> Code m ShakeVarOutFile
Lift)

data ShakeVarOutVector = ShakeVarOutVector
    { ShakeVarOutVector -> Natural
_shakeVarOutCount :: !Natural
    , ShakeVarOutVector -> Natural
_shakeVarOutOutputLen :: !Natural
    , ShakeVarOutVector -> ByteString
_shakeVarOutMsg :: !B.ByteString
    , ShakeVarOutVector -> ByteString
_shakeVarOutOutput :: !B.ByteString
    }
    deriving (Int -> ShakeVarOutVector -> ShowS
[ShakeVarOutVector] -> ShowS
ShakeVarOutVector -> String
(Int -> ShakeVarOutVector -> ShowS)
-> (ShakeVarOutVector -> String)
-> ([ShakeVarOutVector] -> ShowS)
-> Show ShakeVarOutVector
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ShakeVarOutVector -> ShowS
showsPrec :: Int -> ShakeVarOutVector -> ShowS
$cshow :: ShakeVarOutVector -> String
show :: ShakeVarOutVector -> String
$cshowList :: [ShakeVarOutVector] -> ShowS
showList :: [ShakeVarOutVector] -> ShowS
Show, ShakeVarOutVector -> ShakeVarOutVector -> Bool
(ShakeVarOutVector -> ShakeVarOutVector -> Bool)
-> (ShakeVarOutVector -> ShakeVarOutVector -> Bool)
-> Eq ShakeVarOutVector
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ShakeVarOutVector -> ShakeVarOutVector -> Bool
== :: ShakeVarOutVector -> ShakeVarOutVector -> Bool
$c/= :: ShakeVarOutVector -> ShakeVarOutVector -> Bool
/= :: ShakeVarOutVector -> ShakeVarOutVector -> Bool
Eq, Eq ShakeVarOutVector
Eq ShakeVarOutVector =>
(ShakeVarOutVector -> ShakeVarOutVector -> Ordering)
-> (ShakeVarOutVector -> ShakeVarOutVector -> Bool)
-> (ShakeVarOutVector -> ShakeVarOutVector -> Bool)
-> (ShakeVarOutVector -> ShakeVarOutVector -> Bool)
-> (ShakeVarOutVector -> ShakeVarOutVector -> Bool)
-> (ShakeVarOutVector -> ShakeVarOutVector -> ShakeVarOutVector)
-> (ShakeVarOutVector -> ShakeVarOutVector -> ShakeVarOutVector)
-> Ord ShakeVarOutVector
ShakeVarOutVector -> ShakeVarOutVector -> Bool
ShakeVarOutVector -> ShakeVarOutVector -> Ordering
ShakeVarOutVector -> ShakeVarOutVector -> ShakeVarOutVector
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 :: ShakeVarOutVector -> ShakeVarOutVector -> Ordering
compare :: ShakeVarOutVector -> ShakeVarOutVector -> Ordering
$c< :: ShakeVarOutVector -> ShakeVarOutVector -> Bool
< :: ShakeVarOutVector -> ShakeVarOutVector -> Bool
$c<= :: ShakeVarOutVector -> ShakeVarOutVector -> Bool
<= :: ShakeVarOutVector -> ShakeVarOutVector -> Bool
$c> :: ShakeVarOutVector -> ShakeVarOutVector -> Bool
> :: ShakeVarOutVector -> ShakeVarOutVector -> Bool
$c>= :: ShakeVarOutVector -> ShakeVarOutVector -> Bool
>= :: ShakeVarOutVector -> ShakeVarOutVector -> Bool
$cmax :: ShakeVarOutVector -> ShakeVarOutVector -> ShakeVarOutVector
max :: ShakeVarOutVector -> ShakeVarOutVector -> ShakeVarOutVector
$cmin :: ShakeVarOutVector -> ShakeVarOutVector -> ShakeVarOutVector
min :: ShakeVarOutVector -> ShakeVarOutVector -> ShakeVarOutVector
Ord)
    deriving ((forall (m :: * -> *). Quote m => ShakeVarOutVector -> m Exp)
-> (forall (m :: * -> *).
    Quote m =>
    ShakeVarOutVector -> Code m ShakeVarOutVector)
-> Lift ShakeVarOutVector
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => ShakeVarOutVector -> m Exp
forall (m :: * -> *).
Quote m =>
ShakeVarOutVector -> Code m ShakeVarOutVector
$clift :: forall (m :: * -> *). Quote m => ShakeVarOutVector -> m Exp
lift :: forall (m :: * -> *). Quote m => ShakeVarOutVector -> m Exp
$cliftTyped :: forall (m :: * -> *).
Quote m =>
ShakeVarOutVector -> Code m ShakeVarOutVector
liftTyped :: forall (m :: * -> *).
Quote m =>
ShakeVarOutVector -> Code m ShakeVarOutVector
Lift)

pShakeVarOutFile :: Parser ShakeVarOutFile
pShakeVarOutFile :: Parser ShakeVarOutFile
pShakeVarOutFile = Text
-> Natural
-> Natural
-> Natural
-> Vector ShakeVarOutVector
-> ShakeVarOutFile
ShakeVarOutFile
    (Text
 -> Natural
 -> Natural
 -> Natural
 -> Vector ShakeVarOutVector
 -> ShakeVarOutFile)
-> Parser Text Text
-> Parser
     Text
     (Natural
      -> Natural
      -> Natural
      -> Vector ShakeVarOutVector
      -> ShakeVarOutFile)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Text
pDescription
    Parser
  Text
  (Natural
   -> Natural
   -> Natural
   -> Vector ShakeVarOutVector
   -> ShakeVarOutFile)
-> Parser Text Text
-> Parser
     Text
     (Natural
      -> Natural
      -> Natural
      -> Vector ShakeVarOutVector
      -> ShakeVarOutFile)
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*  (Parser ()
skipSpace Parser () -> Parser Text Text -> Parser Text Text
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Text -> Parser Text Text
string Text
"[Tested for Output of byte-oriented messages]")
    Parser
  Text
  (Natural
   -> Natural
   -> Natural
   -> Vector ShakeVarOutVector
   -> ShakeVarOutFile)
-> Parser Text Natural
-> Parser
     Text
     (Natural -> Natural -> Vector ShakeVarOutVector -> ShakeVarOutFile)
forall a b. Parser Text (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ()
skipSpace Parser () -> Parser Text Natural -> Parser Text Natural
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text Natural
pInputLength)
    Parser
  Text
  (Natural -> Natural -> Vector ShakeVarOutVector -> ShakeVarOutFile)
-> Parser Text Natural
-> Parser
     Text (Natural -> Vector ShakeVarOutVector -> ShakeVarOutFile)
forall a b. Parser Text (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ()
skipSpace Parser () -> Parser Text Natural -> Parser Text Natural
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text Natural
pMinOutput)
    Parser
  Text (Natural -> Vector ShakeVarOutVector -> ShakeVarOutFile)
-> Parser Text Natural
-> Parser Text (Vector ShakeVarOutVector -> ShakeVarOutFile)
forall a b. Parser Text (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ()
skipSpace Parser () -> Parser Text Natural -> Parser Text Natural
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text Natural
pMaxOutput)
    Parser Text (Vector ShakeVarOutVector -> ShakeVarOutFile)
-> Parser Text (Vector ShakeVarOutVector) -> Parser ShakeVarOutFile
forall a b. Parser Text (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ()
skipSpace Parser ()
-> Parser Text (Vector ShakeVarOutVector)
-> Parser Text (Vector ShakeVarOutVector)
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text (Vector ShakeVarOutVector)
pVectors)
    Parser ShakeVarOutFile -> Parser () -> Parser ShakeVarOutFile
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (Parser ()
skipSpace Parser () -> Parser () -> Parser ()
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
forall t. Chunk t => Parser t ()
endOfInput)
    Parser ShakeVarOutFile -> String -> Parser ShakeVarOutFile
forall i a. Parser i a -> String -> Parser i a
<?> String
"RspVarOutFile"
  where
    pInputLength :: Parser Natural
    pInputLength :: Parser Text Natural
pInputLength = Parser Text Natural -> Parser Text Natural
forall a. Parser a -> Parser a
pInBrackets (Text -> Parser Text Natural -> Parser Text Natural
forall a. Text -> Parser a -> Parser a
pEquals Text
"Input Length" Parser Text Natural
forall a. Integral a => Parser a
decimal)
        Parser Text Natural -> String -> Parser Text Natural
forall i a. Parser i a -> String -> Parser i a
<?> String
"InputLength"

    pMinOutput :: Parser Natural
    pMinOutput :: Parser Text Natural
pMinOutput = Parser Text Natural -> Parser Text Natural
forall a. Parser a -> Parser a
pInBrackets (Text -> Parser Text Natural -> Parser Text Natural
forall a. Text -> Parser a -> Parser a
pEquals Text
"Minimum Output Length (bits)" Parser Text Natural
forall a. Integral a => Parser a
decimal)
        Parser Text Natural -> String -> Parser Text Natural
forall i a. Parser i a -> String -> Parser i a
<?> String
"MinOutput"

    pMaxOutput :: Parser Natural
    pMaxOutput :: Parser Text Natural
pMaxOutput = Parser Text Natural -> Parser Text Natural
forall a. Parser a -> Parser a
pInBrackets (Text -> Parser Text Natural -> Parser Text Natural
forall a. Text -> Parser a -> Parser a
pEquals Text
"Maximum Output Length (bits)" Parser Text Natural
forall a. Integral a => Parser a
decimal)
        Parser Text Natural -> String -> Parser Text Natural
forall i a. Parser i a -> String -> Parser i a
<?> String
"MaxOutput"

    pVectors :: Parser (V.Vector ShakeVarOutVector)
    pVectors :: Parser Text (Vector ShakeVarOutVector)
pVectors = [ShakeVarOutVector] -> Vector ShakeVarOutVector
forall a. [a] -> Vector a
V.fromList
        ([ShakeVarOutVector] -> Vector ShakeVarOutVector)
-> Parser Text [ShakeVarOutVector]
-> Parser Text (Vector ShakeVarOutVector)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text ShakeVarOutVector -> Parser Text [ShakeVarOutVector]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many1 (Parser ()
skipSpace Parser ()
-> Parser Text ShakeVarOutVector -> Parser Text ShakeVarOutVector
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text ShakeVarOutVector
pVector)
        Parser Text (Vector ShakeVarOutVector)
-> String -> Parser Text (Vector ShakeVarOutVector)
forall i a. Parser i a -> String -> Parser i a
<?> String
"ShakeVarOutVectors"

    pVector :: Parser ShakeVarOutVector
    pVector :: Parser Text ShakeVarOutVector
pVector = Natural -> Natural -> ByteString -> ByteString -> ShakeVarOutVector
ShakeVarOutVector
        (Natural
 -> Natural -> ByteString -> ByteString -> ShakeVarOutVector)
-> Parser Text Natural
-> Parser
     Text (Natural -> ByteString -> ByteString -> ShakeVarOutVector)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser ()
skipSpace Parser () -> Parser Text Natural -> Parser Text Natural
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Text -> Parser Text Natural -> Parser Text Natural
forall a. Text -> Parser a -> Parser a
pEquals Text
"COUNT" Parser Text Natural
forall a. Integral a => Parser a
decimal)
        Parser
  Text (Natural -> ByteString -> ByteString -> ShakeVarOutVector)
-> Parser Text Natural
-> Parser Text (ByteString -> ByteString -> ShakeVarOutVector)
forall a b. Parser Text (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ()
skipSpace Parser () -> Parser Text Natural -> Parser Text Natural
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Text -> Parser Text Natural -> Parser Text Natural
forall a. Text -> Parser a -> Parser a
pEquals Text
"Outputlen" Parser Text Natural
forall a. Integral a => Parser a
decimal)
        Parser Text (ByteString -> ByteString -> ShakeVarOutVector)
-> Parser Text ByteString
-> Parser Text (ByteString -> ShakeVarOutVector)
forall a b. Parser Text (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ()
skipSpace Parser () -> Parser Text ByteString -> Parser Text ByteString
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Text -> Parser Text ByteString -> Parser Text ByteString
forall a. Text -> Parser a -> Parser a
pEquals Text
"Msg" Parser Text ByteString
hexbytes)
        Parser Text (ByteString -> ShakeVarOutVector)
-> Parser Text ByteString -> Parser Text ShakeVarOutVector
forall a b. Parser Text (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ()
skipSpace Parser () -> Parser Text ByteString -> Parser Text ByteString
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Text -> Parser Text ByteString -> Parser Text ByteString
forall a. Text -> Parser a -> Parser a
pEquals Text
"Output" Parser Text ByteString
hexbytes)
        Parser Text ShakeVarOutVector
-> String -> Parser Text ShakeVarOutVector
forall i a. Parser i a -> String -> Parser i a
<?> String
"ShakeVarOutVector"

readShakeVarOutFile :: FilePath -> IO ShakeVarOutFile
readShakeVarOutFile :: String -> IO ShakeVarOutFile
readShakeVarOutFile = String -> Parser ShakeVarOutFile -> String -> IO ShakeVarOutFile
forall a. String -> Parser a -> String -> IO a
parseFile String
"readShakeVarOutFile" Parser ShakeVarOutFile
pShakeVarOutFile

embedShakeVarOutFile :: FilePath -> Code Q ShakeVarOutFile
embedShakeVarOutFile :: String -> Code Q ShakeVarOutFile
embedShakeVarOutFile = IO ShakeVarOutFile -> Code Q ShakeVarOutFile
forall a. Lift a => IO a -> Code Q a
embedIO (IO ShakeVarOutFile -> Code Q ShakeVarOutFile)
-> (String -> IO ShakeVarOutFile)
-> String
-> Code Q ShakeVarOutFile
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ShakeVarOutFile
readShakeVarOutFile

-- -------------------------------------------------------------------------- --
-- Common Parsers

pInBrackets :: Parser a -> Parser a
pInBrackets :: forall a. Parser a -> Parser a
pInBrackets Parser a
p = Char -> Parser Char
char Char
'[' Parser Char -> Parser a -> Parser a
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser a
p Parser a -> Parser Char -> Parser a
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Char
char Char
']' Parser a -> String -> Parser a
forall i a. Parser i a -> String -> Parser i a
<?> String
"pInBrackets"

pEquals :: T.Text -> Parser a -> Parser a
pEquals :: forall a. Text -> Parser a -> Parser a
pEquals Text
prompt Parser a
p = Text -> Parser Text Text
string Text
prompt
    Parser Text Text -> Parser () -> Parser ()
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
skipSpace
    Parser () -> Parser Char -> Parser Char
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> Parser Char
char Char
'='
    Parser Char -> Parser () -> Parser ()
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
skipSpace Parser () -> Parser a -> Parser a
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser a
p
    Parser a -> String -> Parser a
forall i a. Parser i a -> String -> Parser i a
<?> (String
"pEquals[" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
prompt String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"]")

pDescription :: Parser T.Text
pDescription :: Parser Text Text
pDescription = Text -> [Text] -> Text
T.intercalate Text
"\n"
    ([Text] -> Text) -> Parser Text [Text] -> Parser Text Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Text -> Parser () -> Parser Text [Text]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
sepBy Parser Text Text
descLine Parser ()
endOfLine
    Parser Text Text -> String -> Parser Text Text
forall i a. Parser i a -> String -> Parser i a
<?> String
"Description"
  where
    descLine :: Parser Text Text
descLine = Text -> Parser Text Text
string Text
"#  " Parser Text Text -> Parser Text Text -> Parser Text Text
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> Parser Text Text
takeTill Char -> Bool
isEndOfLine Parser Text Text -> String -> Parser Text Text
forall i a. Parser i a -> String -> Parser i a
<?> String
"Line"

pL :: Parser Natural
pL :: Parser Text Natural
pL = Parser Text Natural -> Parser Text Natural
forall a. Parser a -> Parser a
pInBrackets (Text -> Parser Text Natural -> Parser Text Natural
forall a. Text -> Parser a -> Parser a
pEquals Text
"L" Parser Text Natural
forall a. Integral a => Parser a
decimal) Parser Text Natural -> String -> Parser Text Natural
forall i a. Parser i a -> String -> Parser i a
<?> String
"L"

hexbytes :: Parser B.ByteString
hexbytes :: Parser Text ByteString
hexbytes = Parser Text ByteString
go Parser Text ByteString -> String -> Parser Text ByteString
forall i a. Parser i a -> String -> Parser i a
<?> String
"hexbytes"
  where
    go :: Parser Text ByteString
go = do
        Text
h <- (Char -> Bool) -> Parser Text Text
takeWhile1 (String -> Char -> Bool
inClass String
"0-9a-fA-F")
        -- h <- takeWhile1 (inClass "0123456789abcdefABCDEF")
        -- h <- Data.Attoparsec.Text.Lazy.takeWhile (inClass "0-9a-fA-F")
        case ByteString -> Either String ByteString
B16.decode (Text -> ByteString
T.encodeUtf8 Text
h) of
#if MIN_VERSION_base16_bytestring(1,0,0)
            Left String
e -> String -> Parser Text ByteString
forall a. String -> Parser Text a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Text ByteString)
-> String -> Parser Text ByteString
forall a b. (a -> b) -> a -> b
$ String
"failed to decode hex-encoded bytes: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
e
            Right ByteString
r -> ByteString -> Parser Text ByteString
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
r
#else
            (r,"") -> return r
            (r,e) -> fail "failed to decode hex-encoded bytes because of invalid input characters"
#endif

parseFile :: String -> Parser a -> FilePath -> IO a
parseFile :: forall a. String -> Parser a -> String -> IO a
parseFile String
label Parser a
p String
fp = Parser a -> Text -> Either String a
forall a. Parser a -> Text -> Either String a
parseOnly Parser a
p (Text -> Either String a) -> IO Text -> IO (Either String a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO Text
TL.readFile String
fp IO (Either String a) -> (Either String a -> IO a) -> IO a
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Right a
r -> a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
r
    Left String
e -> String -> IO a
forall a. HasCallStack => String -> a
error (String -> IO a) -> String -> IO a
forall a b. (a -> b) -> a -> b
$ String
label String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
": failed to parse file " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
fp String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
": " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
e

-- -------------------------------------------------------------------------- --
-- File embedding

embedIO :: Lift a => IO a -> Code Q a
embedIO :: forall a. Lift a => IO a -> Code Q a
embedIO IO a
action = IO a -> Q a
forall a. IO a -> Q a
runIO IO a
action Q a -> (a -> Code Q a) -> Code Q a
forall (m :: * -> *) a b.
Monad m =>
m a -> (a -> Code m b) -> Code m b
`bindCode` a -> Code Q a
forall t (m :: * -> *). (Lift t, Quote m) => t -> Code m t
forall (m :: * -> *). Quote m => a -> Code m a
liftTyped

-- | The returned paths are relative to the given directory
--
listFiles :: String -> FilePath -> IO [FilePath]
listFiles :: String -> String -> IO [String]
listFiles String
suffix String
r = String -> IO [String]
listDirectory String
r
    IO [String] -> ([String] -> IO [String]) -> IO [String]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> IO Bool) -> [String] -> IO [String]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (String -> IO Bool
doesFileExist (String -> IO Bool) -> ShowS -> String -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
r String -> ShowS
</>))
    IO [String] -> ([String] -> IO [String]) -> IO [String]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> IO Bool) -> [String] -> IO [String]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM ((Permissions -> Bool) -> IO Permissions -> IO Bool
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Permissions -> Bool
readable (IO Permissions -> IO Bool)
-> (String -> IO Permissions) -> String -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO Permissions
getPermissions (String -> IO Permissions) -> ShowS -> String -> IO Permissions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
r String -> ShowS
</>))
    IO [String] -> ([String] -> [String]) -> IO [String]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
L.isSuffixOf (String
"." String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
suffix))

{-
-- | Running this slice produces @[(FilePath, RspFile)]@.
--
-- It does not recurse into subdirectories and ignores any files that do
-- not have an the suffix @.rsp@.
--
-- The file path is the (relative) file name within the given directory.
--
embedRspFiles :: FilePath -> ExpQ
embedRspFiles fp = SigE
    <$> (runIO (readRspDir fp) >>= lift)
    <*> [t| [(FilePath, RspFile)] |]

readRspDir :: FilePath -> IO [(FilePath, RspFile)]
readRspDir fp = do
    paths <- listRspFiles fp
    forM paths $ \p -> (p,) <$> readRspFile (fp </> p)
-}

-- -------------------------------------------------------------------------- --
-- Orphan Lift instances
--
-- Requires template-haskell >=2.16

#if ! MIN_VERSION_bytestring(0,11,2)
instance Lift B.ByteString where
    lift bs = return
        $ AppE (VarE 'unsafePerformIO)
        $ AppE
        ( AppE
            (VarE 'B.unsafePackAddressLen)
            (LitE (IntegerL $ fromIntegral $ B8.length bs))
        )
        (LitE (bytesPrimL (mkBytes ptr (fromIntegral off) (fromIntegral sz))))
      where
        B.PS ptr off sz = bs

    liftTyped = code . unsafeTExpCoerce . lift
#endif

instance (Lift a) => Lift (V.Vector a) where
    lift :: forall (m :: * -> *). Quote m => Vector a -> m Exp
lift Vector a
v = [| V.fromListN n' v' |]
      where
        n' :: Int
n' = Vector a -> Int
forall a. Vector a -> Int
V.length Vector a
v
        v' :: [a]
v' = Vector a -> [a]
forall a. Vector a -> [a]
V.toList Vector a
v
    liftTyped :: forall (m :: * -> *). Quote m => Vector a -> Code m (Vector a)
liftTyped = m (TExp (Vector a)) -> Code m (Vector a)
forall (m :: * -> *) a. m (TExp a) -> Code m a
code (m (TExp (Vector a)) -> Code m (Vector a))
-> (Vector a -> m (TExp (Vector a)))
-> Vector a
-> Code m (Vector a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m Exp -> m (TExp (Vector a))
forall a (m :: * -> *). Quote m => m Exp -> m (TExp a)
unsafeTExpCoerce (m Exp -> m (TExp (Vector a)))
-> (Vector a -> m Exp) -> Vector a -> m (TExp (Vector a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector a -> m Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => Vector a -> m Exp
lift

-- -------------------------------------------------------------------------- --
-- Test Tools

-- | Check that all test vectors in a File are satisfied by a given hash
-- implementation.
--
msgTest :: (B.ByteString -> B.ByteString) -> MsgFile -> Bool
msgTest :: (ByteString -> ByteString) -> MsgFile -> Bool
msgTest ByteString -> ByteString
hash MsgFile
f = (MsgVector -> Bool) -> [MsgVector] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\MsgVector
v -> MsgVector -> ByteString
hashVector MsgVector
v ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== MsgVector -> ByteString
_msgMd MsgVector
v) (Vector MsgVector -> [MsgVector]
forall a. Vector a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Vector MsgVector -> [MsgVector])
-> Vector MsgVector -> [MsgVector]
forall a b. (a -> b) -> a -> b
$ MsgFile -> Vector MsgVector
_msgVectors MsgFile
f)
  where
    hashVector :: MsgVector -> ByteString
hashVector MsgVector
v = ByteString -> ByteString
hash
        (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
B.take (Natural -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (MsgVector -> Natural
_msgLen MsgVector
v) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
8)
        (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ MsgVector -> ByteString
_msgMsg MsgVector
v

-- | For a given hash implementation, assert the correct result for each test
-- vector in a 'MsgFile'.
--
-- The function to assert equality is usually provided by some testing
-- framework.
--
msgAssert
    :: Monad m
    => (String -> B.ByteString -> B.ByteString -> m ())
        -- ^ Function to assertion Equality. The first argument is a test label,
        -- the second argument is the actual value, and the thrid value is the
        -- expected value.
    -> (B.ByteString -> B.ByteString)
        -- ^ Hash function
    -> MsgFile
    -> m ()
msgAssert :: forall (m :: * -> *).
Monad m =>
(String -> ByteString -> ByteString -> m ())
-> (ByteString -> ByteString) -> MsgFile -> m ()
msgAssert String -> ByteString -> ByteString -> m ()
assert ByteString -> ByteString
hash MsgFile
f = [(Natural, MsgVector)] -> ((Natural, MsgVector) -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Natural, MsgVector)]
vs (((Natural, MsgVector) -> m ()) -> m ())
-> ((Natural, MsgVector) -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \(Natural
i, MsgVector
v) ->
    String -> ByteString -> ByteString -> m ()
assert (Natural -> ByteString -> String
mkTestLabel Natural
i (MsgVector -> ByteString
_msgMsg MsgVector
v)) (MsgVector -> ByteString
hashVector MsgVector
v) (MsgVector -> ByteString
_msgMd MsgVector
v)
  where
    vs :: [(Natural, MsgVector)]
vs = [Natural] -> [MsgVector] -> [(Natural, MsgVector)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Natural
1..] (Vector MsgVector -> [MsgVector]
forall a. Vector a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Vector MsgVector -> [MsgVector])
-> Vector MsgVector -> [MsgVector]
forall a b. (a -> b) -> a -> b
$ MsgFile -> Vector MsgVector
_msgVectors MsgFile
f)
    hashVector :: MsgVector -> ByteString
hashVector MsgVector
v = ByteString -> ByteString
hash
        (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
B.take (Natural -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (MsgVector -> Natural
_msgLen MsgVector
v) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
8)
        (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ MsgVector -> ByteString
_msgMsg MsgVector
v

monteAssertInternal
    :: Monad m
    => Natural
        -- ^ seed multiplyer
    -> (String -> B.ByteString -> B.ByteString -> m ())
        -- ^ Function to assertion Equality. The first argument is a test label,
        -- the second argument is the actual value, and the thrid value is the
        -- expected value.
    -> (B.ByteString -> B.ByteString)
        -- ^ Hash function
    -> MonteFile
    -> m ()
monteAssertInternal :: forall (m :: * -> *).
Monad m =>
Natural
-> (String -> ByteString -> ByteString -> m ())
-> (ByteString -> ByteString)
-> MonteFile
-> m ()
monteAssertInternal Natural
seedMultiplyer String -> ByteString -> ByteString -> m ()
assert ByteString -> ByteString
hash MonteFile
f = ByteString -> [MonteVector] -> m ()
go (MonteFile -> ByteString
_monteSeed MonteFile
f) (Vector MonteVector -> [MonteVector]
forall a. Vector a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Vector MonteVector -> [MonteVector])
-> Vector MonteVector -> [MonteVector]
forall a b. (a -> b) -> a -> b
$ MonteFile -> Vector MonteVector
_monteVectors MonteFile
f)
  where
    size :: Int
size = Natural -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (MonteFile -> Natural
_monteL MonteFile
f)
    multiplySeed :: ByteString -> ByteString
multiplySeed = [ByteString] -> ByteString
forall a. Monoid a => [a] -> a
mconcat ([ByteString] -> ByteString)
-> (ByteString -> [ByteString]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> [ByteString]
forall a. Int -> a -> [a]
replicate (Natural -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
seedMultiplyer)

    go :: ByteString -> [MonteVector] -> m ()
go ByteString
_ [] = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    go ByteString
s (MonteVector
v : [MonteVector]
t) = do
        let r :: ByteString
r = Natural -> ByteString -> ByteString
hashI Natural
1000 (ByteString -> ByteString
multiplySeed ByteString
s)
        let md :: ByteString
md = MonteVector -> ByteString
_monteMd MonteVector
v
        String -> ByteString -> ByteString -> m ()
assert (Natural -> ByteString -> String
mkTestLabel (MonteVector -> Natural
_monteCount MonteVector
v) ByteString
md) ByteString
md ByteString
r
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ByteString
r ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
md) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ ByteString -> [MonteVector] -> m ()
go ByteString
md [MonteVector]
t

    -- Each Round consists of 1000 hash applications
    hashI :: Natural -> B.ByteString -> B.ByteString
    hashI :: Natural -> ByteString -> ByteString
hashI Natural
0 ByteString
s = Int -> ByteString -> ByteString
B.takeEnd Int
size ByteString
s
    hashI Natural
i ByteString
s = let s' :: ByteString
s' = ByteString -> ByteString
hash ByteString
s in Natural -> ByteString -> ByteString
hashI (Natural
i Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
- Natural
1) (Int -> ByteString -> ByteString
B.drop Int
size ByteString
s ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
s')

monteTestInternal
    :: Natural
    -> (B.ByteString -> B.ByteString)
    -> MonteFile
    -> Bool
monteTestInternal :: Natural -> (ByteString -> ByteString) -> MonteFile -> Bool
monteTestInternal Natural
i ByteString -> ByteString
h MonteFile
f = case Natural
-> (String -> ByteString -> ByteString -> Maybe ())
-> (ByteString -> ByteString)
-> MonteFile
-> Maybe ()
forall (m :: * -> *).
Monad m =>
Natural
-> (String -> ByteString -> ByteString -> m ())
-> (ByteString -> ByteString)
-> MonteFile
-> m ()
monteAssertInternal Natural
i String -> ByteString -> ByteString -> Maybe ()
forall {f :: * -> *} {a} {p}.
(Alternative f, Eq a) =>
p -> a -> a -> f ()
check ByteString -> ByteString
h MonteFile
f of
    Maybe ()
Nothing -> Bool
False
    Just () -> Bool
True
  where
    check :: p -> a -> a -> f ()
check p
_ a
a a
b = Bool -> f ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
b)

mkTestLabel :: Natural -> B.ByteString -> String
mkTestLabel :: Natural -> ByteString -> String
mkTestLabel Natural
i ByteString
input = Natural -> String
forall a. Show a => a -> String
show Natural
i String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"[" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ByteString -> String
B8.unpack ByteString
msg String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"]"
    where
    hex :: ByteString
hex = ByteString -> ByteString
B16.encode ByteString
input
    msg :: ByteString
msg
        | ByteString -> Int
B.length ByteString
hex Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
16 = Int -> ByteString -> ByteString
B.take Int
16 ByteString
hex
        | Bool
otherwise = Int -> ByteString -> ByteString
B.take Int
13 ByteString
hex ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"..."