test/semantics.hs · reflex

on develop help sign in

reflex/test/semantics.hs

47 lines 1.3 kB history raw

1{-# LANGUAGE ConstraintKinds #-}

2{-# LANGUAGE FlexibleContexts #-}

3{-# LANGUAGE FlexibleInstances #-}

4{-# LANGUAGE GADTs #-}

5{-# LANGUAGE MultiParamTypeClasses #-}

6{-# LANGUAGE RankNTypes #-}

8module Main (main) where

10import Reflex.Test

12import Data.Bifunctor

13import Data.Functor

14import Data.List

15import qualified Reflex.Bench.Focused as Focused

16import qualified Reflex.Test.Micro as Micro

18import System.Environment

19import System.Exit

21import Prelude

23matchPrefixes :: [String] -> (String -> Bool)

24matchPrefixes [] = const True

25matchPrefixes args = \name -> any (`isPrefixOf` name) args

28main :: IO ()

29main = do

30 args <- getArgs

32 case args of

33 ["--list"] -> mapM_ putStrLn (fst <$> allTests) >> exitWith (ExitFailure 1)

34 _ -> case filter (matchPrefixes args . fst) allTests of

35 [] -> putStrLn "filter did not match any tests" >> exitWith (ExitFailure 1)

36 tests -> runTests tests

38 where

39 allTests = concat

40 [ makeGroup "micro" Micro.testCases

41 , makeGroup "subscribing (100,40)" (Focused.subscribing 100 40)

42 , makeGroup "firing 1000" (Focused.firing 1000)

43 , makeGroup "merge 100" (Focused.merging 100)

44 , makeGroup "fan 50" (Focused.fans 50)

45 ]

47 makeGroup name tests = first (\test -> intercalate "/" [name, test]) <$> tests