{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
module Foundation.Timing.Main
( defaultMain
) where
import Basement.Imports
import Foundation.IO.Terminal
import Foundation.Collection
data MainConfig = MainConfig
{ MainConfig -> Bool
mainHelp :: Bool
, MainConfig -> Bool
mainListBenchs :: Bool
, MainConfig -> Bool
mainVerbose :: Bool
, MainConfig -> [String]
mainOther :: [String]
}
newtype TimingPlan a = TimingPlan { forall a. TimingPlan a -> IO a
runTimingPlan :: IO a }
deriving (forall a b. a -> TimingPlan b -> TimingPlan a
forall a b. (a -> b) -> TimingPlan a -> TimingPlan b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> TimingPlan b -> TimingPlan a
$c<$ :: forall a b. a -> TimingPlan b -> TimingPlan a
fmap :: forall a b. (a -> b) -> TimingPlan a -> TimingPlan b
$cfmap :: forall a b. (a -> b) -> TimingPlan a -> TimingPlan b
Functor, Functor TimingPlan
forall a. a -> TimingPlan a
forall a b. TimingPlan a -> TimingPlan b -> TimingPlan a
forall a b. TimingPlan a -> TimingPlan b -> TimingPlan b
forall a b. TimingPlan (a -> b) -> TimingPlan a -> TimingPlan b
forall a b c.
(a -> b -> c) -> TimingPlan a -> TimingPlan b -> TimingPlan c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. TimingPlan a -> TimingPlan b -> TimingPlan a
$c<* :: forall a b. TimingPlan a -> TimingPlan b -> TimingPlan a
*> :: forall a b. TimingPlan a -> TimingPlan b -> TimingPlan b
$c*> :: forall a b. TimingPlan a -> TimingPlan b -> TimingPlan b
liftA2 :: forall a b c.
(a -> b -> c) -> TimingPlan a -> TimingPlan b -> TimingPlan c
$cliftA2 :: forall a b c.
(a -> b -> c) -> TimingPlan a -> TimingPlan b -> TimingPlan c
<*> :: forall a b. TimingPlan (a -> b) -> TimingPlan a -> TimingPlan b
$c<*> :: forall a b. TimingPlan (a -> b) -> TimingPlan a -> TimingPlan b
pure :: forall a. a -> TimingPlan a
$cpure :: forall a. a -> TimingPlan a
Applicative, Applicative TimingPlan
forall a. a -> TimingPlan a
forall a b. TimingPlan a -> TimingPlan b -> TimingPlan b
forall a b. TimingPlan a -> (a -> TimingPlan b) -> TimingPlan b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> TimingPlan a
$creturn :: forall a. a -> TimingPlan a
>> :: forall a b. TimingPlan a -> TimingPlan b -> TimingPlan b
$c>> :: forall a b. TimingPlan a -> TimingPlan b -> TimingPlan b
>>= :: forall a b. TimingPlan a -> (a -> TimingPlan b) -> TimingPlan b
$c>>= :: forall a b. TimingPlan a -> (a -> TimingPlan b) -> TimingPlan b
Monad)
defaultMainConfig :: MainConfig
defaultMainConfig :: MainConfig
defaultMainConfig = MainConfig
{ mainHelp :: Bool
mainHelp = Bool
False
, mainListBenchs :: Bool
mainListBenchs = Bool
False
, mainVerbose :: Bool
mainVerbose = Bool
False
, mainOther :: [String]
mainOther = []
}
parseArgs :: [String] -> MainConfig -> Either String MainConfig
parseArgs :: [String] -> MainConfig -> Either String MainConfig
parseArgs [] MainConfig
cfg = forall a b. b -> Either a b
Right MainConfig
cfg
parseArgs (String
"--list-benchs":[String]
xs) MainConfig
cfg = [String] -> MainConfig -> Either String MainConfig
parseArgs [String]
xs forall a b. (a -> b) -> a -> b
$ MainConfig
cfg { mainListBenchs :: Bool
mainListBenchs = Bool
True }
parseArgs (String
"--verbose":[String]
xs) MainConfig
cfg = [String] -> MainConfig -> Either String MainConfig
parseArgs [String]
xs forall a b. (a -> b) -> a -> b
$ MainConfig
cfg { mainVerbose :: Bool
mainVerbose = Bool
True }
parseArgs (String
"--help":[String]
xs) MainConfig
cfg = [String] -> MainConfig -> Either String MainConfig
parseArgs [String]
xs forall a b. (a -> b) -> a -> b
$ MainConfig
cfg { mainHelp :: Bool
mainHelp = Bool
True }
parseArgs (String
x:[String]
xs) MainConfig
cfg = [String] -> MainConfig -> Either String MainConfig
parseArgs [String]
xs forall a b. (a -> b) -> a -> b
$ MainConfig
cfg { mainOther :: [String]
mainOther = String
x forall a. a -> [a] -> [a]
: MainConfig -> [String]
mainOther MainConfig
cfg }
configHelp :: [String]
configHelp :: [String]
configHelp = []
defaultMain :: TimingPlan () -> IO ()
defaultMain :: TimingPlan () -> IO ()
defaultMain TimingPlan ()
tp = do
Either String MainConfig
ecfg <- forall a b c. (a -> b -> c) -> b -> a -> c
flip [String] -> MainConfig -> Either String MainConfig
parseArgs MainConfig
defaultMainConfig forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [String]
getArgs
MainConfig
cfg <- case Either String MainConfig
ecfg of
Left String
e -> do
String -> IO ()
putStrLn String
e
forall (col :: * -> *) (m :: * -> *) a b.
(Mappable col, Applicative m, Monad m) =>
(a -> m b) -> col a -> m ()
mapM_ String -> IO ()
putStrLn [String]
configHelp
forall a. IO a
exitFailure
Right MainConfig
c -> forall (f :: * -> *) a. Applicative f => a -> f a
pure MainConfig
c
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (MainConfig -> Bool
mainHelp MainConfig
cfg) (forall (col :: * -> *) (m :: * -> *) a b.
(Mappable col, Applicative m, Monad m) =>
(a -> m b) -> col a -> m ()
mapM_ String -> IO ()
putStrLn [String]
configHelp forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. IO a
exitSuccess)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (MainConfig -> Bool
mainListBenchs MainConfig
cfg) (forall {a}. a
printAll forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. IO a
exitSuccess)
forall a. TimingPlan a -> IO a
runTimingPlan TimingPlan ()
tp
forall (m :: * -> *) a. Monad m => a -> m a
return ()
where
printAll :: a
printAll = forall a. HasCallStack => a
undefined