-- |
-- Module      : Foundation.Timing.Main
-- License     : BSD-style
-- Maintainer  : Foundation maintainers
--
-- An implementation of a timing framework
--
{-# 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