Avoid using maybe for filepath in ob profile

lib/command/src/Obelisk/Command.hs

@@ -13,9 +13,12 @@ import qualified Data.ByteString.Base16 as Base16
 import qualified Data.ByteString.Lazy as LBS
 import Data.Foldable (for_)
 import Data.List
+import Data.Maybe
 import qualified Data.Text as T
 import Data.Text.Encoding
 import Data.Text.Encoding.Error (lenientDecode)
+import Data.Time.Clock
+import Data.Time.Format (formatTime, defaultTimeLocale)
 import GHC.StaticPtr
 import Options.Applicative
 import Options.Applicative.Help.Pretty (text, (<$$>))
@@ -50,8 +53,8 @@ newtype ArgsConfig = ArgsConfig
   { _argsConfig_enableVmBuilderByDefault :: Bool
   }
 
-args :: ArgsConfig -> Parser Args
-args cfg = Args <$> noHandoff <*> verbose <*> obCommand cfg
+args :: ArgsConfig -> UTCTime -> Maybe FilePath -> Parser Args
+args cfg time root = Args <$> noHandoff <*> verbose <*> obCommand cfg time root
 
 noHandoff :: Parser Bool
 noHandoff = flag False True $ mconcat
@@ -67,8 +70,8 @@ verbose = flag False True $ mconcat
   , help "Be more verbose"
   ]
 
-argsInfo :: ArgsConfig -> ParserInfo Args
-argsInfo cfg = info (args cfg <**> helper) $ mconcat
+argsInfo :: ArgsConfig -> UTCTime -> Maybe FilePath -> ParserInfo Args
+argsInfo cfg time root = info (args cfg time root <**> helper) $ mconcat
   [ fullDesc
   , progDesc "Manage Obelisk projects"
   ]
@@ -87,7 +90,7 @@ data ObCommand
    = ObCommand_Init InitSource Bool
    | ObCommand_Deploy DeployCommand
    | ObCommand_Run
-   | ObCommand_Profile (Maybe FilePath)
+   | ObCommand_Profile FilePath
    | ObCommand_Thunk ThunkCommand
    | ObCommand_Repl
    | ObCommand_Watch
@@ -103,13 +106,13 @@ data ObInternal
    = ObInternal_ApplyPackages String String String [String]
    deriving Show
 
-obCommand :: ArgsConfig -> Parser ObCommand
-obCommand cfg = hsubparser
+obCommand :: ArgsConfig -> UTCTime -> Maybe FilePath -> Parser ObCommand
+obCommand cfg time root = hsubparser
   (mconcat
     [ command "init" $ info (ObCommand_Init <$> initSource <*> initForce) $ progDesc "Initialize an Obelisk project"
     , command "deploy" $ info (ObCommand_Deploy <$> deployCommand cfg) $ progDesc "Prepare a deployment for an Obelisk project"
     , command "run" $ info (pure ObCommand_Run) $ progDesc "Run current project in development mode"
-    , command "profile" $ info (ObCommand_Profile <$> optional (strOption ( long "output" <> short 'o' <> metavar "BASEPATH" ))) $ progDesc "Run current project with profiling enabled"
+    , command "profile" $ info (ObCommand_Profile <$> option auto (long "output" <> short 'o' <> help "Base output to use for profiling output. Suffixes are added to this based on the profiling type." <> showDefault <> value ((fromMaybe "" root) </> "profile" </> formatTime defaultTimeLocale "%Y-%m-%dT%H:%M:%S" time) <> metavar "PATH")) $ progDesc "Run current project with profiling enabled"
     , command "thunk" $ info (ObCommand_Thunk <$> thunkCommand) $ progDesc "Manipulate thunk directories"
     , command "repl" $ info (pure ObCommand_Repl) $ progDesc "Open an interactive interpreter"
     , command "watch" $ info (pure ObCommand_Watch) $ progDesc "Watch current project for errors and warnings"
@@ -250,8 +253,8 @@ parserPrefs = defaultPrefs
   { prefShowHelpOnEmpty = True
   }
 
-parseCLIArgs :: ArgsConfig -> [String] -> IO Args
-parseCLIArgs cfg = handleParseResult . execParserPure parserPrefs (argsInfo cfg)
+parseCLIArgs :: ArgsConfig -> UTCTime -> Maybe FilePath -> [String] -> IO Args
+parseCLIArgs cfg time root = handleParseResult . execParserPure parserPrefs (argsInfo cfg time root)
 
 -- | Create an Obelisk config for the current process.
 mkObeliskConfig :: IO Obelisk
@@ -306,12 +309,15 @@ main' argsCfg = do
     , "logging-level=" <> show logLevel
     ]
 
+  time <- liftIO $ getCurrentTime
+  root <- findProjectRoot "."
+
   --TODO: We'd like to actually use the parser to determine whether to hand off,
   --but in the case where this implementation of 'ob' doesn't support all
   --arguments being passed along, this could fail.  For now, we don't bother
   --with optparse-applicative until we've done the handoff.
   let go as = do
-        args' <- liftIO $ handleParseResult (execParserPure parserPrefs (argsInfo argsCfg) as)
+        args' <- liftIO $ handleParseResult (execParserPure parserPrefs (argsInfo argsCfg time root) as)
         case _args_noHandOffPassed args' of
           False -> return ()
           True -> putLog Warning "--no-handoff should only be passed once and as the first argument; ignoring"

lib/command/src/Obelisk/Command/Run.hs

@@ -24,8 +24,6 @@ import Data.Maybe
 import qualified Data.Set as Set
 import Data.Text (Text)
 import qualified Data.Text as T
-import Data.Time (getCurrentTime)
-import Data.Time.Format (formatTime, defaultTimeLocale)
 import Data.Traversable (for)
 import Debug.Trace (trace)
 import Distribution.Compiler (CompilerFlavor(..))
@@ -83,20 +81,14 @@ obRunImports = [ "import qualified Obelisk.Run"
 
 profile
   :: MonadObelisk m
-  => Maybe FilePath
+  => FilePath
   -> m ()
-profile mProfileBaseName = withProjectRoot "." $ \root -> do
+profile profileBaseName = withProjectRoot "." $ \root -> do
   freePort <- getFreePort
   assets <- findProjectAssets root
   putLog Debug $ "Assets impurely loaded from: " <> assets
   putLog Debug "Using profiled build of project."
-  time <- liftIO $ formatTime defaultTimeLocale "%Y-%m-%dT%H:%M:%S" <$> getCurrentTime
-  profileBaseName <- case mProfileBaseName of
-    Just baseName -> pure baseName
-    Nothing -> do
-      let profileDirectory = root </> "profile"
-      liftIO $ createDirectoryIfMissing False profileDirectory
-      pure $ profileDirectory </> time
+  liftIO $ createDirectoryIfMissing False $ takeDirectory profileBaseName
   let -- Sane flags to enable by default, enable time profiling +
       -- closure heap profiling.
       rtsFlags = [ "+RTS", "-p", "-po" <> profileBaseName, "-hc", "-RTS" ]