{-# 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 { TimingPlan a -> IO a
runTimingPlan :: IO a }
deriving (a -> TimingPlan b -> TimingPlan a
(a -> b) -> TimingPlan a -> TimingPlan b
(forall a b. (a -> b) -> TimingPlan a -> TimingPlan b)
-> (forall a b. a -> TimingPlan b -> TimingPlan a)
-> Functor TimingPlan
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
<$ :: a -> TimingPlan b -> TimingPlan a
$c<$ :: forall a b. a -> TimingPlan b -> TimingPlan a
fmap :: (a -> b) -> TimingPlan a -> TimingPlan b
$cfmap :: forall a b. (a -> b) -> TimingPlan a -> TimingPlan b
Functor, Functor TimingPlan
a -> TimingPlan a
Functor TimingPlan
-> (forall a. a -> TimingPlan a)
-> (forall a b.
TimingPlan (a -> b) -> TimingPlan a -> TimingPlan b)
-> (forall a b c.
(a -> b -> c) -> TimingPlan a -> TimingPlan b -> TimingPlan c)
-> (forall a b. TimingPlan a -> TimingPlan b -> TimingPlan b)
-> (forall a b. TimingPlan a -> TimingPlan b -> TimingPlan a)
-> Applicative TimingPlan
TimingPlan a -> TimingPlan b -> TimingPlan b
TimingPlan a -> TimingPlan b -> TimingPlan a
TimingPlan (a -> b) -> TimingPlan a -> TimingPlan b
(a -> b -> c) -> TimingPlan a -> TimingPlan b -> TimingPlan c
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
<* :: TimingPlan a -> TimingPlan b -> TimingPlan a
$c<* :: forall a b. TimingPlan a -> TimingPlan b -> TimingPlan a
*> :: TimingPlan a -> TimingPlan b -> TimingPlan b
$c*> :: forall a b. TimingPlan a -> TimingPlan b -> TimingPlan b
liftA2 :: (a -> b -> c) -> TimingPlan a -> TimingPlan b -> TimingPlan c
$cliftA2 :: forall a b c.
(a -> b -> c) -> TimingPlan a -> TimingPlan b -> TimingPlan c
<*> :: TimingPlan (a -> b) -> TimingPlan a -> TimingPlan b
$c<*> :: forall a b. TimingPlan (a -> b) -> TimingPlan a -> TimingPlan b
pure :: a -> TimingPlan a
$cpure :: forall a. a -> TimingPlan a
$cp1Applicative :: Functor TimingPlan
Applicative, Applicative TimingPlan
a -> TimingPlan a
Applicative TimingPlan
-> (forall a b.
TimingPlan a -> (a -> TimingPlan b) -> TimingPlan b)
-> (forall a b. TimingPlan a -> TimingPlan b -> TimingPlan b)
-> (forall a. a -> TimingPlan a)
-> Monad TimingPlan
TimingPlan a -> (a -> TimingPlan b) -> TimingPlan b
TimingPlan a -> TimingPlan b -> TimingPlan b
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 :: a -> TimingPlan a
$creturn :: forall a. a -> TimingPlan a
>> :: TimingPlan a -> TimingPlan b -> TimingPlan b
$c>> :: forall a b. TimingPlan a -> TimingPlan b -> TimingPlan b
>>= :: TimingPlan a -> (a -> TimingPlan b) -> TimingPlan b
$c>>= :: forall a b. TimingPlan a -> (a -> TimingPlan b) -> TimingPlan b
$cp1Monad :: Applicative TimingPlan
Monad)
defaultMainConfig :: MainConfig
defaultMainConfig :: MainConfig
defaultMainConfig = MainConfig :: Bool -> Bool -> Bool -> [String] -> MainConfig
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 = MainConfig -> Either String MainConfig
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 (MainConfig -> Either String MainConfig)
-> MainConfig -> Either String MainConfig
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 (MainConfig -> Either String MainConfig)
-> MainConfig -> Either String MainConfig
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 (MainConfig -> Either String MainConfig)
-> MainConfig -> Either String MainConfig
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 (MainConfig -> Either String MainConfig)
-> MainConfig -> Either String MainConfig
forall a b. (a -> b) -> a -> b
$ MainConfig
cfg { mainOther :: [String]
mainOther = String
x String -> [String] -> [String]
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 <- ([String] -> MainConfig -> Either String MainConfig)
-> MainConfig -> [String] -> Either String MainConfig
forall a b c. (a -> b -> c) -> b -> a -> c
flip [String] -> MainConfig -> Either String MainConfig
parseArgs MainConfig
defaultMainConfig ([String] -> Either String MainConfig)
-> IO [String] -> IO (Either String MainConfig)
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
(String -> IO ()) -> [String] -> IO ()
forall (col :: * -> *) (m :: * -> *) a b.
(Mappable col, Applicative m, Monad m) =>
(a -> m b) -> col a -> m ()
mapM_ String -> IO ()
putStrLn [String]
configHelp
IO MainConfig
forall a. IO a
exitFailure
Right MainConfig
c -> MainConfig -> IO MainConfig
forall (f :: * -> *) a. Applicative f => a -> f a
pure MainConfig
c
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (MainConfig -> Bool
mainHelp MainConfig
cfg) ((String -> IO ()) -> [String] -> IO ()
forall (col :: * -> *) (m :: * -> *) a b.
(Mappable col, Applicative m, Monad m) =>
(a -> m b) -> col a -> m ()
mapM_ String -> IO ()
putStrLn [String]
configHelp IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
forall a. IO a
exitSuccess)
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (MainConfig -> Bool
mainListBenchs MainConfig
cfg) (IO Any
forall a. a
printAll IO Any -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
forall a. IO a
exitSuccess)
TimingPlan () -> IO ()
forall a. TimingPlan a -> IO a
runTimingPlan TimingPlan ()
tp
() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
where
printAll :: a
printAll = a
forall a. HasCallStack => a
undefined