-- |
-- 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 { 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