{-# LANGUAGE DeriveGeneric    #-}
{-# LANGUAGE QuasiQuotes      #-}
{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_HADDOCK hide #-}
{- HLINT ignore "Avoid restricted function" -}
module Hasklepias.LineFilterApp.ProcessLines.Tests
  ( tests
  , benches
  ) where

import           Control.DeepSeq                            (NFData, force)
import           Control.Exception                          (evaluate)
import           Data.Aeson                                 (FromJSON (parseJSON),
                                                             ToJSON, decode,
                                                             decode',
                                                             decodeStrict,
                                                             decodeStrict',
                                                             encode,
                                                             fromEncoding,
                                                             toEncoding,
                                                             withArray)
import qualified Data.ByteString.Char8                      as BS
import qualified Data.ByteString.Lazy.Char8                 as BL
import           Data.Either
import           Data.List                                  (nub)
import qualified Data.List                                  as L
import qualified Data.Map.Strict                            as M
import           Data.Maybe                                 (mapMaybe)
import           Data.String.Interpolate                    (i)
import qualified Data.Text                                  as T
import qualified Data.Text.Encoding                         as T
import           Data.Vector                                ((!))
import           GHC.Generics
import           GHC.IO.Unsafe                              (unsafePerformIO)
import           Hasklepias.LineFilterApp.ProcessLines.Logic
import           Hasklepias.LineFilterApp.ProcessLines.Taggers
import           Hasklepias.LineFilterApp.AppUtilities
import           Options.Applicative
import           Test.Tasty
import           Test.Tasty.Bench
import           Test.Tasty.HUnit
import           Test.Tasty.QuickCheck                      hiding (output)

{-
      Types for testing
-}

newtype LineAppTesterID
  = MkLineAppTesterID Int
  deriving (LineAppTesterID -> LineAppTesterID -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LineAppTesterID -> LineAppTesterID -> Bool
$c/= :: LineAppTesterID -> LineAppTesterID -> Bool
== :: LineAppTesterID -> LineAppTesterID -> Bool
$c== :: LineAppTesterID -> LineAppTesterID -> Bool
Eq, forall x. Rep LineAppTesterID x -> LineAppTesterID
forall x. LineAppTesterID -> Rep LineAppTesterID x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LineAppTesterID x -> LineAppTesterID
$cfrom :: forall x. LineAppTesterID -> Rep LineAppTesterID x
Generic, Int -> LineAppTesterID -> ShowS
[LineAppTesterID] -> ShowS
LineAppTesterID -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LineAppTesterID] -> ShowS
$cshowList :: [LineAppTesterID] -> ShowS
show :: LineAppTesterID -> String
$cshow :: LineAppTesterID -> String
showsPrec :: Int -> LineAppTesterID -> ShowS
$cshowsPrec :: Int -> LineAppTesterID -> ShowS
Show)

instance FromJSON LineAppTesterID where
  parseJSON :: Value -> Parser LineAppTesterID
parseJSON = forall a. String -> (Array -> Parser a) -> Value -> Parser a
withArray String
"FooID" forall a b. (a -> b) -> a -> b
$ \Array
a -> do
    Int
id <- forall a. FromJSON a => Value -> Parser a
parseJSON (Array
a forall a. Vector a -> Int -> a
! Int
0)
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Int -> LineAppTesterID
MkLineAppTesterID Int
id

instance ToJSON LineAppTesterID

instance Arbitrary LineAppTesterID where
  arbitrary :: Gen LineAppTesterID
arbitrary = Int -> LineAppTesterID
MkLineAppTesterID forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary

newtype LineAppTester
  = MkLineAppTester Bool
  deriving (LineAppTester -> LineAppTester -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LineAppTester -> LineAppTester -> Bool
$c/= :: LineAppTester -> LineAppTester -> Bool
== :: LineAppTester -> LineAppTester -> Bool
$c== :: LineAppTester -> LineAppTester -> Bool
Eq, forall x. Rep LineAppTester x -> LineAppTester
forall x. LineAppTester -> Rep LineAppTester x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LineAppTester x -> LineAppTester
$cfrom :: forall x. LineAppTester -> Rep LineAppTester x
Generic, Eq LineAppTester
LineAppTester -> LineAppTester -> Bool
LineAppTester -> LineAppTester -> Ordering
LineAppTester -> LineAppTester -> LineAppTester
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 :: LineAppTester -> LineAppTester -> LineAppTester
$cmin :: LineAppTester -> LineAppTester -> LineAppTester
max :: LineAppTester -> LineAppTester -> LineAppTester
$cmax :: LineAppTester -> LineAppTester -> LineAppTester
>= :: LineAppTester -> LineAppTester -> Bool
$c>= :: LineAppTester -> LineAppTester -> Bool
> :: LineAppTester -> LineAppTester -> Bool
$c> :: LineAppTester -> LineAppTester -> Bool
<= :: LineAppTester -> LineAppTester -> Bool
$c<= :: LineAppTester -> LineAppTester -> Bool
< :: LineAppTester -> LineAppTester -> Bool
$c< :: LineAppTester -> LineAppTester -> Bool
compare :: LineAppTester -> LineAppTester -> Ordering
$ccompare :: LineAppTester -> LineAppTester -> Ordering
Ord, Int -> LineAppTester -> ShowS
[LineAppTester] -> ShowS
LineAppTester -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LineAppTester] -> ShowS
$cshowList :: [LineAppTester] -> ShowS
show :: LineAppTester -> String
$cshow :: LineAppTester -> String
showsPrec :: Int -> LineAppTester -> ShowS
$cshowsPrec :: Int -> LineAppTester -> ShowS
Show)

instance FromJSON LineAppTester where
  parseJSON :: Value -> Parser LineAppTester
parseJSON = forall a. String -> (Array -> Parser a) -> Value -> Parser a
withArray String
"Foo" forall a b. (a -> b) -> a -> b
$ \Array
a -> do
    Bool
id <- forall a. FromJSON a => Value -> Parser a
parseJSON (Array
a forall a. Vector a -> Int -> a
! Int
1)
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Bool -> LineAppTester
MkLineAppTester Bool
id

instance ToJSON LineAppTester

instance Arbitrary LineAppTester where
  arbitrary :: Gen LineAppTester
arbitrary = Bool -> LineAppTester
MkLineAppTester forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary

data Line
  = MkLine LineAppTesterID String
  deriving (Line -> Line -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Line -> Line -> Bool
$c/= :: Line -> Line -> Bool
== :: Line -> Line -> Bool
$c== :: Line -> Line -> Bool
Eq, forall x. Rep Line x -> Line
forall x. Line -> Rep Line x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Line x -> Line
$cfrom :: forall x. Line -> Rep Line x
Generic, Int -> Line -> ShowS
[Line] -> ShowS
Line -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Line] -> ShowS
$cshowList :: [Line] -> ShowS
show :: Line -> String
$cshow :: Line -> String
showsPrec :: Int -> Line -> ShowS
$cshowsPrec :: Int -> Line -> ShowS
Show)


instance ToJSON Line

dciS' :: ByteString -> Maybe LineAppTesterID
dciS' = forall a. FromJSON a => ByteString -> Maybe a
decodeStrict' @LineAppTesterID
dclS' :: ByteString -> Maybe LineAppTester
dclS' = forall a. FromJSON a => ByteString -> Maybe a
decodeStrict' @LineAppTester
dciS :: ByteString -> Maybe LineAppTesterID
dciS = forall a. FromJSON a => ByteString -> Maybe a
decodeStrict @LineAppTesterID
dclS :: ByteString -> Maybe LineAppTester
dclS = forall a. FromJSON a => ByteString -> Maybe a
decodeStrict @LineAppTester

dciL' :: ByteString -> Maybe LineAppTesterID
dciL' = forall a. FromJSON a => ByteString -> Maybe a
decode' @LineAppTesterID
dclL' :: ByteString -> Maybe LineAppTester
dclL' = forall a. FromJSON a => ByteString -> Maybe a
decode' @LineAppTester
dciL :: ByteString -> Maybe LineAppTesterID
dciL = forall a. FromJSON a => ByteString -> Maybe a
decode @LineAppTesterID
dclL :: ByteString -> Maybe LineAppTester
dclL = forall a. FromJSON a => ByteString -> Maybe a
decode @LineAppTester

tpr :: LineAppTester -> Bool
tpr = (forall a. Eq a => a -> a -> Bool
== Bool -> LineAppTester
MkLineAppTester Bool
True)


{-
      App for demoing the line filter
-}

data TestAppOpts
  = MkTestAppOpts
      { TestAppOpts -> Input
input  :: Input
      , TestAppOpts -> Output
output :: Output
      }


{-
      Test values constructors
-}

mkTestInput :: Int -> T.Text -> BS.ByteString
mkTestInput :: Int -> Text -> ByteString
mkTestInput Int
y Text
x = [i|[#{ show y },#{ x }]|]

mkTestInputL :: Int -> T.Text -> BL.ByteString
mkTestInputL :: Int -> Text -> ByteString
mkTestInputL Int
y Text
x = [i|[#{ show y },#{ x }]|]

mkTestLines :: [(Int, Text)] -> ByteString
mkTestLines [(Int, Text)]
x = ByteString -> [ByteString] -> ByteString
BS.intercalate ByteString
"\n" (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> Text -> ByteString
mkTestInput) [(Int, Text)]
x)

-- Strict bytestrings
passLine :: Int -> ByteString
passLine = forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Text -> ByteString
mkTestInput Text
"true"
failLine :: Int -> ByteString
failLine = forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Text -> ByteString
mkTestInput Text
"false"
badLine :: Int -> ByteString
badLine = forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Text -> ByteString
mkTestInput Text
"1"

mkLines :: Int -> ByteString -> ByteString
mkLines Int
n = [ByteString] -> ByteString
BS.unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> a -> [a]
Prelude.replicate Int
n
passLines :: Int -> Int -> ByteString
passLines Int
n Int
x = Int -> ByteString -> ByteString
mkLines Int
n (Int -> ByteString
passLine Int
x)
failLines :: Int -> Int -> ByteString
failLines Int
n Int
x = Int -> ByteString -> ByteString
mkLines Int
n (Int -> ByteString
failLine Int
x)
badLines :: Int -> Int -> ByteString
badLines Int
n Int
x = Int -> ByteString -> ByteString
mkLines Int
n (Int -> ByteString
badLine Int
x)

nFailOnepass :: Int -> Int -> ByteString
nFailOnepass Int
n Int
x = [ByteString] -> ByteString
BS.concat [Int -> Int -> ByteString
failLines Int
n Int
x, Int -> Int -> ByteString
passLines Int
1 Int
x]
onePassNfail :: Int -> Int -> ByteString
onePassNfail Int
n Int
x = [ByteString] -> ByteString
BS.concat [Int -> Int -> ByteString
passLines Int
1 Int
x, Int -> Int -> ByteString
failLines Int
n Int
x]

mkGroupLines :: [(t -> b -> ByteString, t)] -> ByteString
mkGroupLines [(t -> b -> ByteString, t)]
x = [ByteString] -> ByteString
BS.concat forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
Prelude.zipWith (\(t -> b -> ByteString
f, t
i) -> t -> b -> ByteString
f t
i) [(t -> b -> ByteString, t)]
x [b
1 ..]

-- Lazy btyestrings

passLineL :: Int -> ByteString
passLineL = forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Text -> ByteString
mkTestInputL Text
"true"
failLineL :: Int -> ByteString
failLineL = forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Text -> ByteString
mkTestInputL Text
"false"
badLineL :: Int -> ByteString
badLineL = forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Text -> ByteString
mkTestInputL Text
"1"

mkLinesL :: Int -> ByteString -> ByteString
mkLinesL Int
n = [ByteString] -> ByteString
BL.unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> a -> [a]
Prelude.replicate Int
n
passLinesL :: Int -> Int -> ByteString
passLinesL Int
n Int
x = Int -> ByteString -> ByteString
mkLinesL Int
n (Int -> ByteString
passLineL Int
x)
failLinesL :: Int -> Int -> ByteString
failLinesL Int
n Int
x = Int -> ByteString -> ByteString
mkLinesL Int
n (Int -> ByteString
failLineL Int
x)
badLinesL :: Int -> Int -> ByteString
badLinesL Int
n Int
x = Int -> ByteString -> ByteString
mkLinesL Int
n (Int -> ByteString
badLineL Int
x)

nFailOnepassL :: Int -> Int -> ByteString
nFailOnepassL Int
n Int
x = [ByteString] -> ByteString
BL.concat [Int -> Int -> ByteString
failLinesL Int
n Int
x, Int -> Int -> ByteString
passLinesL Int
1 Int
x]
onePassNfailL :: Int -> Int -> ByteString
onePassNfailL Int
n Int
x = [ByteString] -> ByteString
BL.concat [Int -> Int -> ByteString
passLinesL Int
1 Int
x, Int -> Int -> ByteString
failLinesL Int
n Int
x]

mkGroupLinesL :: [(t -> b -> ByteString, t)] -> ByteString
mkGroupLinesL [(t -> b -> ByteString, t)]
x = [ByteString] -> ByteString
BL.concat forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
Prelude.zipWith (\(t -> b -> ByteString
f, t
i) -> t -> b -> ByteString
f t
i) [(t -> b -> ByteString, t)]
x [b
1 ..]

{-
      Test cases

TODO:
rewrite the case so that test cases for each string type
can be generated by one function,
rather than copy/pasted and modifying (e.g.) passLines to passLinesL.
-}


-- TODO
-- There should be genuine integrations tests for the use-case of reading in
-- codelists, as a project would. That needs to be handled elsewhere
-- unfortunately and should be rolled into
-- https://gitlab.com/TargetRWE/epistats/nsstat/event-data-model/-/issues/62

-- Taggers

-- Tagger <tag type> <key type> <comparison type>
isAllGEThan, hasOui :: Tagger T.Text Integer Integer
isAllGEThan :: Tagger Text Integer Integer
isAllGEThan Map Text Integer
m Integer
i = if Bool
chk then forall a. a -> Maybe a
Just Text
"is_huge" else forall a. a -> Maybe a
Just Text
"is_not_huge"
  where chk :: Bool
chk = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall a. Ord a => a -> a -> Bool
>= Integer
i) forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [a]
M.elems Map Text Integer
m

hasOui :: Tagger Text Integer Integer
hasOui Map Text Integer
m Integer
_ = if forall k a. Ord k => k -> Map k a -> Bool
M.member Text
"oui" Map Text Integer
m then forall a. a -> Maybe a
Just Text
"has_oui" else forall a. Maybe a
Nothing

testTaggerConfig :: TaggerConfig T.Text Integer Integer
testTaggerConfig :: TaggerConfig Text Integer Integer
testTaggerConfig = forall c t m.
FromDhall c =>
[Tagger t c m] -> String -> TaggerConfig t c m
MkTaggerConfig [Tagger Text Integer Integer
isAllGEThan, Tagger Text Integer Integer
hasOui] String
"src/Hasklepias/LineFilterApp/ProcessLines/tests.dhall"

expectedTagMap :: Map Text Integer
expectedTagMap = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Text
"oui", Integer
1), (Text
"non", -Integer
1), (Text
"commeci", Integer
0), (Text
"commeca", Integer
0)]

testTagRunner :: M.Map T.Text Integer -> [Maybe T.Text]
testTagRunner :: Map Text Integer -> [Maybe Text]
testTagRunner Map Text Integer
m = forall a. Ord a => [a] -> [a]
L.sort forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\Tagger Text Integer Integer
f -> Tagger Text Integer Integer
f Map Text Integer
m Integer
1000) forall a b. (a -> b) -> a -> b
$ forall c t m. TaggerConfig t c m -> [Tagger t c m]
taggers TaggerConfig Text Integer Integer
testTaggerConfig

-- Check expectedTagMap for values here
expectedTags :: [Maybe Text]
expectedTags = forall a. Ord a => [a] -> [a]
L.sort [forall a. a -> Maybe a
Just Text
"is_not_huge", forall a. a -> Maybe a
Just Text
"has_oui"]


appTestCasesStrict :: [(String, ByteString, ByteString)]
appTestCasesStrict =
  [ (String
"no input", ByteString
"", ByteString
"")
  , ( String
"without newline at end of input"
    , ByteString
"[1,false]\n[1,true]"
    , ByteString
"[1,false]\n[1,true]"
    )
  , (String
"1 group - 1 passing line"  , Int -> Int -> ByteString
passLines Int
1 Int
1 , Int -> Int -> ByteString
passLines Int
1 Int
1)
  , (String
"1 group -  2 passing lines", Int -> Int -> ByteString
passLines Int
2 Int
1 , Int -> Int -> ByteString
passLines Int
2 Int
1)
  , (String
"1 group - 10 passing lines", Int -> Int -> ByteString
passLines Int
10 Int
1, Int -> Int -> ByteString
passLines Int
10 Int
1)
  -- , ( "1 group - 1 passing line - 1 bad line"
  --   , BS.concat [passLines 1 1, badLines 1 1]
  --   , BS.concat [passLines 1 1, badLines 1 1]
  --   )
  , (String
"1 group - 1 failing line"  , Int -> Int -> ByteString
failLines Int
1 Int
1 , ByteString
"")
  , (String
"1 group - 2 failing lines" , Int -> Int -> ByteString
failLines Int
2 Int
1 , ByteString
"")
  , (String
"1 group - 10 failing lines", Int -> Int -> ByteString
failLines Int
10 Int
1, ByteString
"")
  , ( String
"1 group - 1 failing lines 1 pass line"
    , forall {b} {t}.
(Num b, Enum b) =>
[(t -> b -> ByteString, t)] -> ByteString
mkGroupLines [(Int -> Int -> ByteString
nFailOnepass, Int
1)]
    , forall {b} {t}.
(Num b, Enum b) =>
[(t -> b -> ByteString, t)] -> ByteString
mkGroupLines [(Int -> Int -> ByteString
nFailOnepass, Int
1)]
    )
  , ( String
"1 group - 2 failing lines 1 pass line"
    , forall {b} {t}.
(Num b, Enum b) =>
[(t -> b -> ByteString, t)] -> ByteString
mkGroupLines [(Int -> Int -> ByteString
nFailOnepass, Int
2)]
    , forall {b} {t}.
(Num b, Enum b) =>
[(t -> b -> ByteString, t)] -> ByteString
mkGroupLines [(Int -> Int -> ByteString
nFailOnepass, Int
2)]
    )
  , ( String
"1 group - 10 failing lines 1 pass line"
    , forall {b} {t}.
(Num b, Enum b) =>
[(t -> b -> ByteString, t)] -> ByteString
mkGroupLines [(Int -> Int -> ByteString
nFailOnepass, Int
10)]
    , forall {b} {t}.
(Num b, Enum b) =>
[(t -> b -> ByteString, t)] -> ByteString
mkGroupLines [(Int -> Int -> ByteString
nFailOnepass, Int
10)]
    )
  , ( String
"1 group - 1 pass line 1 fail lines"
    , forall {b} {t}.
(Num b, Enum b) =>
[(t -> b -> ByteString, t)] -> ByteString
mkGroupLines [(Int -> Int -> ByteString
onePassNfail, Int
1)]
    , forall {b} {t}.
(Num b, Enum b) =>
[(t -> b -> ByteString, t)] -> ByteString
mkGroupLines [(Int -> Int -> ByteString
onePassNfail, Int
1)]
    )
  , ( String
"1 group - 1 pass line 2 fail lines"
    , forall {b} {t}.
(Num b, Enum b) =>
[(t -> b -> ByteString, t)] -> ByteString
mkGroupLines [(Int -> Int -> ByteString
onePassNfail, Int
2)]
    , forall {b} {t}.
(Num b, Enum b) =>
[(t -> b -> ByteString, t)] -> ByteString
mkGroupLines [(Int -> Int -> ByteString
onePassNfail, Int
2)]
    )
  , ( String
"1 group - 1 pass line 10 fail lines"
    , forall {b} {t}.
(Num b, Enum b) =>
[(t -> b -> ByteString, t)] -> ByteString
mkGroupLines [(Int -> Int -> ByteString
onePassNfail, Int
10)]
    , forall {b} {t}.
(Num b, Enum b) =>
[(t -> b -> ByteString, t)] -> ByteString
mkGroupLines [(Int -> Int -> ByteString
onePassNfail, Int
10)]
    )
  , ( String
"2 groups - 2 pass groups"
    , forall {b} {t}.
(Num b, Enum b) =>
[(t -> b -> ByteString, t)] -> ByteString
mkGroupLines [(Int -> Int -> ByteString
nFailOnepass, Int
10)]
    , forall {b} {t}.
(Num b, Enum b) =>
[(t -> b -> ByteString, t)] -> ByteString
mkGroupLines [(Int -> Int -> ByteString
nFailOnepass, Int
10)]
    )
  , ( String
"2 groups - 1 pass group"
    , forall {b} {t}.
(Num b, Enum b) =>
[(t -> b -> ByteString, t)] -> ByteString
mkGroupLines [(Int -> Int -> ByteString
nFailOnepass, Int
10), (Int -> Int -> ByteString
failLines, Int
10)]
    , Int -> Int -> ByteString
nFailOnepass Int
10 Int
1
    )
  , ( String
"2 groups - 1 pass group"
    , forall {b} {t}.
(Num b, Enum b) =>
[(t -> b -> ByteString, t)] -> ByteString
mkGroupLines [(Int -> Int -> ByteString
failLines, Int
10), (Int -> Int -> ByteString
nFailOnepass, Int
10)]
    , Int -> Int -> ByteString
nFailOnepass Int
10 Int
2
    )
  , ( String
"2 groups - 0 pass group"
    , forall {b} {t}.
(Num b, Enum b) =>
[(t -> b -> ByteString, t)] -> ByteString
mkGroupLines [(Int -> Int -> ByteString
failLines, Int
10), (Int -> Int -> ByteString
failLines, Int
10)]
    , ByteString
""
    )
  ]

appTestCasesLazy :: [(String, ByteString, ByteString)]
appTestCasesLazy =
  [ (String
"no input", ByteString
"", ByteString
"")
  , ( String
"without newline at end of input"
    , ByteString
"[1,false]\n[1,true]"
    , ByteString
"[1,false]\n[1,true]"
    )
  , (String
"1 group - 1 passing line"  , Int -> Int -> ByteString
passLinesL Int
1 Int
1 , Int -> Int -> ByteString
passLinesL Int
1 Int
1)
  , (String
"1 group - 2 passing lines" , Int -> Int -> ByteString
passLinesL Int
2 Int
1 , Int -> Int -> ByteString
passLinesL Int
2 Int
1)
  , (String
"1 group - 10 passing lines", Int -> Int -> ByteString
passLinesL Int
10 Int
1, Int -> Int -> ByteString
passLinesL Int
10 Int
1)
  -- , ( "1 group - 1 passing line - 1 bad line"
  --   , BL.concat [passLinesL 1 1, badLinesL 1 1]
  --   , BL.concat [passLinesL 1 1, badLinesL 1 1]
  --   )
  , (String
"1 group - 1 failing line"  , Int -> Int -> ByteString
failLinesL Int
1 Int
1 , ByteString
"")
  , (String
"1 group - 2 failing lines" , Int -> Int -> ByteString
failLinesL Int
2 Int
1 , ByteString
"")
  , (String
"1 group - 10 failing lines", Int -> Int -> ByteString
failLinesL Int
10 Int
1, ByteString
"")
  , ( String
"1 group - 1 failing lines 1 pass line"
    , forall {b} {t}.
(Num b, Enum b) =>
[(t -> b -> ByteString, t)] -> ByteString
mkGroupLinesL [(Int -> Int -> ByteString
nFailOnepassL, Int
1)]
    , forall {b} {t}.
(Num b, Enum b) =>
[(t -> b -> ByteString, t)] -> ByteString
mkGroupLinesL [(Int -> Int -> ByteString
nFailOnepassL, Int
1)]
    )
  , ( String
"1 group - 2 failing lines 1 pass line"
    , forall {b} {t}.
(Num b, Enum b) =>
[(t -> b -> ByteString, t)] -> ByteString
mkGroupLinesL [(Int -> Int -> ByteString
nFailOnepassL, Int
2)]
    , forall {b} {t}.
(Num b, Enum b) =>
[(t -> b -> ByteString, t)] -> ByteString
mkGroupLinesL [(Int -> Int -> ByteString
nFailOnepassL, Int
2)]
    )
  , ( String
"1 group - 10 failing lines 1 pass line"
    , forall {b} {t}.
(Num b, Enum b) =>
[(t -> b -> ByteString, t)] -> ByteString
mkGroupLinesL [(Int -> Int -> ByteString
nFailOnepassL, Int
10)]
    , forall {b} {t}.
(Num b, Enum b) =>
[(t -> b -> ByteString, t)] -> ByteString
mkGroupLinesL [(Int -> Int -> ByteString
nFailOnepassL, Int
10)]
    )
  , ( String
"1 group - 1 pass line 1 fail lines"
    , forall {b} {t}.
(Num b, Enum b) =>
[(t -> b -> ByteString, t)] -> ByteString
mkGroupLinesL [(Int -> Int -> ByteString
onePassNfailL, Int
1)]
    , forall {b} {t}.
(Num b, Enum b) =>
[(t -> b -> ByteString, t)] -> ByteString
mkGroupLinesL [(Int -> Int -> ByteString
onePassNfailL, Int
1)]
    )
  , ( String
"1 group - 1 pass line 2 fail lines"
    , forall {b} {t}.
(Num b, Enum b) =>
[(t -> b -> ByteString, t)] -> ByteString
mkGroupLinesL [(Int -> Int -> ByteString
onePassNfailL, Int
2)]
    , forall {b} {t}.
(Num b, Enum b) =>
[(t -> b -> ByteString, t)] -> ByteString
mkGroupLinesL [(Int -> Int -> ByteString
onePassNfailL, Int
2)]
    )
  , ( String
"1 group - 1 pass line 10 fail lines"
    , forall {b} {t}.
(Num b, Enum b) =>
[(t -> b -> ByteString, t)] -> ByteString
mkGroupLinesL [(Int -> Int -> ByteString
onePassNfailL, Int
10)]
    , forall {b} {t}.
(Num b, Enum b) =>
[(t -> b -> ByteString, t)] -> ByteString
mkGroupLinesL [(Int -> Int -> ByteString
onePassNfailL, Int
10)]
    )
  , ( String
"2 groups - 2 pass groups"
    , forall {b} {t}.
(Num b, Enum b) =>
[(t -> b -> ByteString, t)] -> ByteString
mkGroupLinesL [(Int -> Int -> ByteString
nFailOnepassL, Int
10), (Int -> Int -> ByteString
nFailOnepassL, Int
10)]
    , forall {b} {t}.
(Num b, Enum b) =>
[(t -> b -> ByteString, t)] -> ByteString
mkGroupLinesL [(Int -> Int -> ByteString
nFailOnepassL, Int
10), (Int -> Int -> ByteString
nFailOnepassL, Int
10)]
    )
  , ( String
"2 groups - 1 pass group"
    , forall {b} {t}.
(Num b, Enum b) =>
[(t -> b -> ByteString, t)] -> ByteString
mkGroupLinesL [(Int -> Int -> ByteString
nFailOnepassL, Int
10), (Int -> Int -> ByteString
failLinesL, Int
10)]
    , Int -> Int -> ByteString
nFailOnepassL Int
10 Int
1
    )
  , ( String
"2 groups - 1 pass group"
    , forall {b} {t}.
(Num b, Enum b) =>
[(t -> b -> ByteString, t)] -> ByteString
mkGroupLinesL [(Int -> Int -> ByteString
failLinesL, Int
10), (Int -> Int -> ByteString
nFailOnepassL, Int
10)]
    , Int -> Int -> ByteString
nFailOnepassL Int
10 Int
2
    )
  , ( String
"2 groups - 0 pass group"
    , forall {b} {t}.
(Num b, Enum b) =>
[(t -> b -> ByteString, t)] -> ByteString
mkGroupLinesL [(Int -> Int -> ByteString
failLinesL, Int
10), (Int -> Int -> ByteString
failLinesL, Int
10)]
    , ByteString
""
    )
  ]


{-
Tester applications
-}

prsStrict :: ByteString -> LineAppMonad ByteString
prsStrict = forall id a b.
(Eq id, Show id) =>
(ByteString -> Maybe id)
-> (ByteString -> Maybe a)
-> (a -> Bool)
-> LineProcessor a b id
-> ByteString
-> LineAppMonad ByteString
processAppLinesStrict ByteString -> Maybe LineAppTesterID
dciS' ByteString -> Maybe LineAppTester
dclS' LineAppTester -> Bool
tpr forall a b id. LineProcessor a b id
NoTransformation


-- This one converts the bool to a string when the bool is `False`.
-- >>> prsStrictDrop "[1, true]\n[1, false]"
-- Right "[1,\"This line was false\"]\n"
-- >>> prsStrictDrop "[1, true]\n[1, false]\n[2, false]\n[2, true]"
-- Right "[1,\"This line was false\"]\n[2,\"This line was false\"]\n"
-- >>> prsStrictDrop "[1, true]\n[1, false]\n[2, true]\n[2, true]"
-- Right "[1,\"This line was false\"]\n"
--
prsStrictDrop :: ByteString -> LineAppMonad ByteString
prsStrictDrop = forall id a b.
(Eq id, Show id) =>
(ByteString -> Maybe id)
-> (ByteString -> Maybe a)
-> (a -> Bool)
-> LineProcessor a b id
-> ByteString
-> LineAppMonad ByteString
processAppLinesStrict
  ByteString -> Maybe LineAppTesterID
dciS'
  ByteString -> Maybe LineAppTester
dclS'
  LineAppTester -> Bool
tpr
  (forall a b id.
(a -> LineStatus b) -> ((id, b) -> Builder) -> LineProcessor a b id
TransformWith
    (\(MkLineAppTester Bool
x) ->
      if Bool
x then forall b. LineStatus b
DropLine else forall b. b -> LineStatus b
KeepLine String
"This line was false"
    )
    (forall tag. Encoding' tag -> Builder
fromEncoding forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> Encoding
toEncoding forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry LineAppTesterID -> String -> Line
MkLine)
  )

prsLazy :: ByteString -> LineAppMonad ByteString
prsLazy = forall id a b.
(Eq id, Show id) =>
(ByteString -> Maybe id)
-> (ByteString -> Maybe a)
-> (a -> Bool)
-> LineProcessor a b id
-> ByteString
-> LineAppMonad ByteString
processAppLinesLazy ByteString -> Maybe LineAppTesterID
dciL' ByteString -> Maybe LineAppTester
dclL' LineAppTester -> Bool
tpr forall a b id. LineProcessor a b id
NoTransformation



{-
Provides a way to produce a bytestring from generated test inputs.
This is full of kludge at this point
in part due to how the test input functions above are defined.
This could be cleaned/generalized in the future.
-}
makeAppInputs :: [(LineAppTesterID, [LineAppTester])] -> BS.ByteString
makeAppInputs :: [(LineAppTesterID, [LineAppTester])] -> ByteString
makeAppInputs [(LineAppTesterID, [LineAppTester])]
x = ByteString -> [ByteString] -> ByteString
BS.intercalate ByteString
"\n" (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (LineAppTesterID, [LineAppTester]) -> ByteString
f [(LineAppTesterID, [LineAppTester])]
x)
 where
  f :: (LineAppTesterID, [LineAppTester]) -> ByteString
f (MkLineAppTesterID Int
i, [LineAppTester]
xs) = [(Int, Text)] -> ByteString
mkTestLines forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    (\(MkLineAppTester Bool
z) -> (Int
i, ByteString -> Text
T.decodeUtf8 forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BL.toStrict forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> ByteString
encode Bool
z))
    [LineAppTester]
xs

{-
This property checks that:
the count of unique group IDs in the input where at least one line
satisfies the predicate is equal to the count of group IDs obtains
*after* running the inputs through the processAppLines function.
-}
prop_nGroups :: [(LineAppTesterID, [LineAppTester])] -> Property
prop_nGroups :: [(LineAppTesterID, [LineAppTester])] -> Property
prop_nGroups [(LineAppTesterID, [LineAppTester])]
x = do
  let naiveN :: Int
naiveN =
        forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. (a -> Bool) -> [a] -> [a]
filter (\(LineAppTesterID
i, [LineAppTester]
lines) -> forall (t :: * -> *). Foldable t => t Bool -> Bool
or (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LineAppTester -> Bool
tpr [LineAppTester]
lines)) [(LineAppTesterID, [LineAppTester])]
x
  let appOutput :: LineAppMonad ByteString
appOutput = ByteString -> LineAppMonad ByteString
prsStrict ([(LineAppTesterID, [LineAppTester])] -> ByteString
makeAppInputs [(LineAppTesterID, [LineAppTester])]
x)
  let appN :: Int
appN = forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ByteString -> Maybe LineAppTesterID
dciS' (ByteString -> [ByteString]
BS.lines (forall b a. b -> Either a b -> b
fromRight ByteString
"" LineAppMonad ByteString
appOutput))

  Int
naiveN forall a. (Eq a, Show a) => a -> a -> Property
=== Int
appN

{-
      Tests
-}

tests :: TestTree
tests = String -> [TestTree] -> TestTree
testGroup
  String
"line processing logic"
  [ String -> [TestTree] -> TestTree
testGroup
    String
"filter lines application"
    [ String -> Assertion -> TestTree
testCase String
"identifier failure caught"
    forall a b. (a -> b) -> a -> b
$   forall a. Show a => a -> String
show (ByteString -> LineAppMonad ByteString
prsStrict ByteString
"[1, true]\n[bad]")
    forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= String
"Left Line 2: failed to decode identifier"
    , String -> Assertion -> TestTree
testCase String
"identifier failure caught"
    forall a b. (a -> b) -> a -> b
$   forall a. Show a => a -> String
show (ByteString -> LineAppMonad ByteString
prsStrict ByteString
"[1, \"bad\"]\n[1, false]")
    forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= String
"Left Line 1: failed to decode line"
    , String -> [TestTree] -> TestTree
testGroup String
"processAppLinesStrict" forall a b. (a -> b) -> a -> b
$ forall {f :: * -> *} {a} {t} {a}.
(Functor f, Eq a, Show a) =>
(t -> Either a a) -> f (String, t, a) -> f TestTree
makeTests ByteString -> LineAppMonad ByteString
prsStrict [(String, ByteString, ByteString)]
appTestCasesStrict
    , String -> [TestTree] -> TestTree
testGroup String
"processAppLinesLazy" forall a b. (a -> b) -> a -> b
$ forall {f :: * -> *} {a} {t} {a}.
(Functor f, Eq a, Show a) =>
(t -> Either a a) -> f (String, t, a) -> f TestTree
makeTests ByteString -> LineAppMonad ByteString
prsLazy [(String, ByteString, ByteString)]
appTestCasesLazy
    , forall a. Testable a => String -> a -> TestTree
testProperty
      String
"number of groups determined by processAppLines is same as naive implementation"
      [(LineAppTesterID, [LineAppTester])] -> Property
prop_nGroups
    ]
  , String -> [TestTree] -> TestTree
testGroup
    String
"filter and process application - silly logic"
    [ String -> Assertion -> TestTree
testCase String
"silly logic gives correct result on silly input"
    forall a b. (a -> b) -> a -> b
$   ByteString -> LineAppMonad ByteString
prsStrictDrop ByteString
"[1,false]\n[1,true]\n"
    forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= forall a b. b -> Either a b
Right ByteString
"[1,\"This line was false\"]\n"
    , String -> Assertion -> TestTree
testCase String
"order of true line doesn't matter for silly logic"
    forall a b. (a -> b) -> a -> b
$   ByteString -> LineAppMonad ByteString
prsStrictDrop ByteString
"[1,false]\n[1,true]\n"
    forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= ByteString -> LineAppMonad ByteString
prsStrictDrop ByteString
"[1,true]\n[1,false]\n"
    , String -> Assertion -> TestTree
testCase
      String
"two false lines equal two true lines since true lines are dropped in silly logic"
    forall a b. (a -> b) -> a -> b
$   ByteString -> LineAppMonad ByteString
prsStrictDrop ByteString
"[1,false]\n[1,false]\n"
    forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= ByteString -> LineAppMonad ByteString
prsStrictDrop ByteString
"[1,true]\n[1,true]\n"
    ]
  , String -> [TestTree] -> TestTree
testGroup
  String
"tagger"
  [ String -> Assertion -> TestTree
testCase
  String
"parse tests.dhall"
  forall a b. (a -> b) -> a -> b
$ forall a. IO a -> a
unsafePerformIO (forall t c m. TaggerConfig t c m -> IO (Map Text c)
inputTagMap TaggerConfig Text Integer Integer
testTaggerConfig)
  forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Map Text Integer
expectedTagMap
  , String -> Assertion -> TestTree
testCase String
"elementary tagging succeeds"
  forall a b. (a -> b) -> a -> b
$ Map Text Integer -> [Maybe Text]
testTagRunner (forall a. IO a -> a
unsafePerformIO (forall t c m. TaggerConfig t c m -> IO (Map Text c)
inputTagMap TaggerConfig Text Integer Integer
testTaggerConfig))
  forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= [Maybe Text]
expectedTags
  ]
  ]
 where
  makeTests :: (t -> Either a a) -> f (String, t, a) -> f TestTree
makeTests t -> Either a a
f = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    (\(String
n, t
i, a
r) -> case t -> Either a a
f t
i of
      Left a
_ ->
        String -> Assertion -> TestTree
testCase String
n forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => String -> IO a
assertFailure String
"Boom! this failed and shouldn't have"
      Right a
a -> String -> Assertion -> TestTree
testCase String
n forall a b. (a -> b) -> a -> b
$ forall a.
(Eq a, Show a, HasCallStack) =>
String -> a -> a -> Assertion
assertEqual String
"These should be equal" a
r a
a
    )
  readOne :: a -> Maybe a
readOne a
x | a
x forall a. Eq a => a -> a -> Bool
== a
"1"  = forall a. a -> Maybe a
Just a
1
            | a
x forall a. Eq a => a -> a -> Bool
== a
"2"  = forall a. a -> Maybe a
Just a
2
            | Bool
otherwise = forall a. Maybe a
Nothing

{-
    Benchmarks
-}

makeAppBenchInputStrict :: (t -> b -> ByteString) -> t -> Int -> ByteString
makeAppBenchInputStrict t -> b -> ByteString
f t
m Int
n = forall {b} {t}.
(Num b, Enum b) =>
[(t -> b -> ByteString, t)] -> ByteString
mkGroupLines forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> [a]
Prelude.replicate Int
n (t -> b -> ByteString
f, t
m)

makeAppBenchInputsStrict :: [(String, Int -> Int -> ByteString)]
makeAppBenchInputsStrict =
  [ (String
"all-pass"  , forall {b} {t}.
(Num b, Enum b) =>
(t -> b -> ByteString) -> t -> Int -> ByteString
makeAppBenchInputStrict Int -> Int -> ByteString
passLines)
  , (String
"all-fail"  , forall {b} {t}.
(Num b, Enum b) =>
(t -> b -> ByteString) -> t -> Int -> ByteString
makeAppBenchInputStrict Int -> Int -> ByteString
failLines)
  , (String
"first-pass", forall {b} {t}.
(Num b, Enum b) =>
(t -> b -> ByteString) -> t -> Int -> ByteString
makeAppBenchInputStrict Int -> Int -> ByteString
onePassNfail)
  , (String
"last-pass" , forall {b} {t}.
(Num b, Enum b) =>
(t -> b -> ByteString) -> t -> Int -> ByteString
makeAppBenchInputStrict Int -> Int -> ByteString
nFailOnepass)
  ]

makeAppBenchInputLazy :: (t -> b -> ByteString) -> t -> Int -> ByteString
makeAppBenchInputLazy t -> b -> ByteString
f t
m Int
n = forall {b} {t}.
(Num b, Enum b) =>
[(t -> b -> ByteString, t)] -> ByteString
mkGroupLinesL forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> [a]
Prelude.replicate Int
n (t -> b -> ByteString
f, t
m)

makeAppBenchInputsLazy :: [(String, Int -> Int -> ByteString)]
makeAppBenchInputsLazy =
  [ (String
"all-pass"  , forall {b} {t}.
(Num b, Enum b) =>
(t -> b -> ByteString) -> t -> Int -> ByteString
makeAppBenchInputLazy Int -> Int -> ByteString
passLinesL)
  , (String
"all-fail"  , forall {b} {t}.
(Num b, Enum b) =>
(t -> b -> ByteString) -> t -> Int -> ByteString
makeAppBenchInputLazy Int -> Int -> ByteString
failLinesL)
  , (String
"first-pass", forall {b} {t}.
(Num b, Enum b) =>
(t -> b -> ByteString) -> t -> Int -> ByteString
makeAppBenchInputLazy Int -> Int -> ByteString
onePassNfailL)
  , (String
"last-pass" , forall {b} {t}.
(Num b, Enum b) =>
(t -> b -> ByteString) -> t -> Int -> ByteString
makeAppBenchInputLazy Int -> Int -> ByteString
nFailOnepassL)
  ]

-- appBenchCounts = [(10000, 10), (1000, 100), (100, 1000), (10, 10000)]

appBenchCounts :: [(Int, Int)]
appBenchCounts = [(Int
1000, Int
1), (Int
100, Int
10), (Int
10, Int
100), (Int
1, Int
1000)]


cartProd :: f a -> f a -> f (a, a)
cartProd f a
x f a
y = (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
x forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f a
y

appBenchInputsStrict :: [(String, BS.ByteString)]
appBenchInputsStrict :: [(String, ByteString)]
appBenchInputsStrict = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
  (\((Int
m, Int
n), (String
s, Int -> Int -> ByteString
f)) -> (forall a. Show a => a -> String
show Int
n forall a. Semigroup a => a -> a -> a
<> String
"groups-" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
m forall a. Semigroup a => a -> a -> a
<> String
"lines-" forall a. Semigroup a => a -> a -> a
<> String
s, Int -> Int -> ByteString
f Int
m Int
n))
  (forall {f :: * -> *} {a} {a}.
Applicative f =>
f a -> f a -> f (a, a)
cartProd [(Int, Int)]
appBenchCounts [(String, Int -> Int -> ByteString)]
makeAppBenchInputsStrict)

appBenchInputsLazy :: [(String, BL.ByteString)]
appBenchInputsLazy :: [(String, ByteString)]
appBenchInputsLazy = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
  (\((Int
m, Int
n), (String
s, Int -> Int -> ByteString
f)) -> (forall a. Show a => a -> String
show Int
n forall a. Semigroup a => a -> a -> a
<> String
"groups-" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
m forall a. Semigroup a => a -> a -> a
<> String
"lines-" forall a. Semigroup a => a -> a -> a
<> String
s, Int -> Int -> ByteString
f Int
m Int
n))
  (forall {f :: * -> *} {a} {a}.
Applicative f =>
f a -> f a -> f (a, a)
cartProd [(Int, Int)]
appBenchCounts [(String, Int -> Int -> ByteString)]
makeAppBenchInputsLazy)


makeBench
  :: (NFData a, NFData b) => (a -> b) -> String -> a -> String -> Benchmark
makeBench :: forall a b.
(NFData a, NFData b) =>
(a -> b) -> String -> a -> String -> TestTree
makeBench a -> b
f String
fn a
i String
ipts =
  forall env. NFData env => IO env -> (env -> TestTree) -> TestTree
env (forall a. a -> IO a
evaluate (forall a. NFData a => a -> a
force a
i)) forall a b. (a -> b) -> a -> b
$ \a
d -> String -> Benchmarkable -> TestTree
bench (String
fn forall a. Semigroup a => a -> a -> a
<> String
":" forall a. Semigroup a => a -> a -> a
<> String
ipts) forall a b. (a -> b) -> a -> b
$ forall b a. NFData b => (a -> b) -> a -> Benchmarkable
nf a -> b
f a
d

runAppExperimentStrict :: [TestTree]
runAppExperimentStrict = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
  (\((String
inputLabel, ByteString
input), (String
fLabel, ByteString -> ByteString
f)) -> forall a b.
(NFData a, NFData b) =>
(a -> b) -> String -> a -> String -> TestTree
makeBench ByteString -> ByteString
f String
fLabel ByteString
input String
inputLabel)
  (forall {f :: * -> *} {a} {a}.
Applicative f =>
f a -> f a -> f (a, a)
cartProd [(String, ByteString)]
appBenchInputsStrict [(String
"", forall b a. b -> Either a b -> b
fromRight ByteString
"" forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> LineAppMonad ByteString
prsStrict)])

runAppExperimentLazy :: [TestTree]
runAppExperimentLazy = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
  (\((String
inputLabel, ByteString
input), (String
fLabel, ByteString -> ByteString
f)) -> forall a b.
(NFData a, NFData b) =>
(a -> b) -> String -> a -> String -> TestTree
makeBench ByteString -> ByteString
f String
fLabel ByteString
input String
inputLabel)
  (forall {f :: * -> *} {a} {a}.
Applicative f =>
f a -> f a -> f (a, a)
cartProd [(String, ByteString)]
appBenchInputsLazy [(String
"", forall b a. b -> Either a b -> b
fromRight ByteString
"" forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> LineAppMonad ByteString
prsLazy)])

benches :: TestTree
benches = String -> [TestTree] -> TestTree
bgroup
  String
"line processing benchmarks"
  [ String -> [TestTree] -> TestTree
bgroup String
"strict bytestring" [TestTree]
runAppExperimentStrict
  , String -> [TestTree] -> TestTree
bgroup String
"lazy bytestring"   [TestTree]
runAppExperimentLazy
  ]