{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE NoImplicitPrelude #-}

-- | This module contains the podenv CLI entrypoint
-- The workflow is: Main -> Config -> Build -> Application -> Context
--
-- * Main: select the app and override with command line arguments
-- * Config: load the configuration and select the application
-- * Build: optional application build
-- * App: convert application and capability into a Context
-- * Runtime: execute with podman or kubernetes
module Podenv.Main
  ( main,
    runApp,

    -- * exports for tests
    usage,
    cliConfigLoad,
    cliInfo,
    cliPrepare,
    CLI (..),
  )
where

import Data.Text qualified
import Data.Version (showVersion)
import Options.Applicative hiding (command)
import Paths_podenv (version)
import Podenv.Application qualified
import Podenv.Build qualified
import Podenv.Config qualified
import Podenv.Dhall
import Podenv.Prelude
import Podenv.Runtime (Context, Name (..), RuntimeEnv (..))
import Podenv.Runtime qualified
import Podenv.Version qualified (version)

-- | podenv entrypoint
main :: IO ()
main :: IO ()
main = do
  cli :: CLI
cli@CLI {Bool
[Text]
[Capabilities -> Capabilities]
Maybe Text
cliExtraArgs :: CLI -> [Text]
selector :: CLI -> Maybe Text
volumes :: CLI -> [Text]
cliEnv :: CLI -> [Text]
name :: CLI -> Maybe Text
namespace :: CLI -> Maybe Text
shell :: CLI -> Bool
capsOverride :: CLI -> [Capabilities -> Capabilities]
detach :: CLI -> Bool
verbose :: CLI -> Bool
update :: CLI -> Bool
configExpr :: CLI -> Maybe Text
showApplication :: CLI -> Bool
showDhallEnv :: CLI -> Bool
showManifest :: CLI -> Bool
listCaps :: CLI -> Bool
listApps :: CLI -> Bool
cliExtraArgs :: [Text]
selector :: Maybe Text
volumes :: [Text]
cliEnv :: [Text]
name :: Maybe Text
namespace :: Maybe Text
shell :: Bool
capsOverride :: [Capabilities -> Capabilities]
detach :: Bool
verbose :: Bool
update :: Bool
configExpr :: Maybe Text
showApplication :: Bool
showDhallEnv :: Bool
showManifest :: Bool
listCaps :: Bool
listApps :: Bool
..} <- [String] -> IO CLI
usage ([String] -> IO CLI) -> IO [String] -> IO CLI
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO [String]
forall (m :: * -> *). MonadIO m => m [String]
getArgs
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
showManifest (Maybe Text -> IO ()
printManifest Maybe Text
configExpr IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
forall (m :: * -> *) a. MonadIO m => m a
exitSuccess)
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
showDhallEnv (Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putTextLn Text
Podenv.Config.podenvImportTxt IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
forall (m :: * -> *) a. MonadIO m => m a
exitSuccess)
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
listCaps (IO ()
printCaps IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
forall (m :: * -> *) a. MonadIO m => m a
exitSuccess)
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
listApps (Maybe Text -> IO ()
printApps Maybe Text
configExpr IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
forall (m :: * -> *) a. MonadIO m => m a
exitSuccess)

  (Application
baseApp, Mode
mode, Name
ctxName, RuntimeEnv
re) <- CLI -> IO (Application, Mode, Name, RuntimeEnv)
cliConfigLoad CLI
cli
  (BuildEnv
be, Application
app) <- RuntimeEnv -> Application -> IO (BuildEnv, Application)
Podenv.Build.prepare RuntimeEnv
re Application
baseApp
  Context
ctx <- Mode -> Application -> Name -> IO Context
Podenv.Application.prepare Mode
mode Application
app Name
ctxName

  if Bool
showApplication
    then Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putTextLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Application -> Context -> BuildEnv -> RuntimeEnv -> Text
showApp Application
app Context
ctx BuildEnv
be RuntimeEnv
re
    else do
      BuildEnv -> AppRunner -> IO ()
Podenv.Build.beEnsure BuildEnv
be (RuntimeEnv -> AppRunner
runApp RuntimeEnv
re)
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
update (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ BuildEnv -> AppRunner -> IO ()
Podenv.Build.beUpdate BuildEnv
be (RuntimeEnv -> AppRunner
runApp RuntimeEnv
re)
      RuntimeEnv -> Context -> IO ()
Podenv.Runtime.execute RuntimeEnv
re Context
ctx

-- | helper function to run a Application.
runApp :: Podenv.Runtime.RuntimeEnv -> Application -> IO ()
runApp :: RuntimeEnv -> AppRunner
runApp RuntimeEnv
re Application
app = do
  Context
ctx <- Mode -> Application -> Name -> IO Context
Podenv.Application.prepare Mode
Podenv.Application.Regular Application
app (Text -> Name
Name (Text -> Name) -> Text -> Name
forall a b. (a -> b) -> a -> b
$ Application
app Application
-> FoldLike Text Application Application Text Text -> Text
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike Text Application Application Text Text
forall (f :: * -> *).
Functor f =>
(Text -> f Text) -> Application -> f Application
appName)
  RuntimeEnv -> Context -> IO ()
Podenv.Runtime.execute RuntimeEnv
re Context
ctx

usage :: [String] -> IO CLI
usage :: [String] -> IO CLI
usage [String]
args = do
  CLI
cli <- ParserResult CLI -> IO CLI
forall a. ParserResult a -> IO a
handleParseResult (ParserResult CLI -> IO CLI) -> ParserResult CLI -> IO CLI
forall a b. (a -> b) -> a -> b
$ ParserPrefs -> ParserInfo CLI -> [String] -> ParserResult CLI
forall a. ParserPrefs -> ParserInfo a -> [String] -> ParserResult a
execParserPure ParserPrefs
defaultPrefs ParserInfo CLI
cliInfo [String]
cliArgs
  CLI -> IO CLI
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CLI -> IO CLI) -> CLI -> IO CLI
forall a b. (a -> b) -> a -> b
$ CLI
cli {cliExtraArgs :: [Text]
cliExtraArgs = (String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map String -> Text
forall a. ToText a => a -> Text
toText [String]
appArgs}
  where
    cliArgs :: [String]
cliArgs = [String] -> [String] -> [String]
takeCliArgs [] [String]
args
    appArgs :: [String]
appArgs = case Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop ([String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
cliArgs) [String]
args of
      -- Drop any `--` prefix
      (String
"--" : [String]
rest) -> [String]
rest
      [String]
xs -> [String]
xs

    -- Collect args until the selector, the rest should not be passed to optparse-applicative
    isPodenvArg :: String -> Bool
isPodenvArg String
arg
      | String
arg String -> [String] -> Bool
forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
`elem` [String]
strOptions Bool -> Bool -> Bool
|| String
"--bash-completion-" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
arg = Bool
True
      | Bool
otherwise = Bool
False
    takeCliArgs :: [String] -> [String] -> [String]
takeCliArgs [String]
acc [String]
args' = case [String]
args' of
      [] -> [String] -> [String]
forall a. [a] -> [a]
reverse [String]
acc
      -- Handle toggle such as `"--name" : "app-name" : _`
      (String
toggle : String
x : [String]
xs) | String -> Bool
isPodenvArg String
toggle -> [String] -> [String] -> [String]
takeCliArgs (String
x String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String
toggle String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
acc) [String]
xs
      (String
x : [String]
xs)
        -- `--` is a hard separator, stop now.
        | String
"--" String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
x -> [String] -> [String] -> [String]
takeCliArgs [String]
acc []
        -- this is switch, keep on taking
        | String
"--" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
x -> [String] -> [String] -> [String]
takeCliArgs (String
x String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
acc) [String]
xs
        -- otherwise the selector is found, stop now
        | Bool
otherwise -> [String] -> [String] -> [String]
takeCliArgs (String
x String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
acc) []

data CLI = CLI
  { -- action modes:
    CLI -> Bool
listApps :: Bool,
    CLI -> Bool
listCaps :: Bool,
    CLI -> Bool
showManifest :: Bool,
    CLI -> Bool
showDhallEnv :: Bool,
    CLI -> Bool
showApplication :: Bool,
    CLI -> Maybe Text
configExpr :: Maybe Text,
    -- runtime env:
    CLI -> Bool
update :: Bool,
    CLI -> Bool
verbose :: Bool,
    CLI -> Bool
detach :: Bool,
    -- app modifiers:
    CLI -> [Capabilities -> Capabilities]
capsOverride :: [Capabilities -> Capabilities],
    CLI -> Bool
shell :: Bool,
    CLI -> Maybe Text
namespace :: Maybe Text,
    CLI -> Maybe Text
name :: Maybe Text,
    CLI -> [Text]
cliEnv :: [Text],
    CLI -> [Text]
volumes :: [Text],
    -- app selector and arguments:
    CLI -> Maybe Text
selector :: Maybe Text,
    CLI -> [Text]
cliExtraArgs :: [Text]
  }

-- WARNING: when adding strOption, update the 'strOptions' list
cliParser :: Parser CLI
cliParser :: Parser CLI
cliParser =
  Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Maybe Text
-> Bool
-> Bool
-> Bool
-> [Capabilities -> Capabilities]
-> Bool
-> Maybe Text
-> Maybe Text
-> [Text]
-> [Text]
-> Maybe Text
-> [Text]
-> CLI
CLI
    -- action modes:
    (Bool
 -> Bool
 -> Bool
 -> Bool
 -> Bool
 -> Maybe Text
 -> Bool
 -> Bool
 -> Bool
 -> [Capabilities -> Capabilities]
 -> Bool
 -> Maybe Text
 -> Maybe Text
 -> [Text]
 -> [Text]
 -> Maybe Text
 -> [Text]
 -> CLI)
-> Parser Bool
-> Parser
     (Bool
      -> Bool
      -> Bool
      -> Bool
      -> Maybe Text
      -> Bool
      -> Bool
      -> Bool
      -> [Capabilities -> Capabilities]
      -> Bool
      -> Maybe Text
      -> Maybe Text
      -> [Text]
      -> [Text]
      -> Maybe Text
      -> [Text]
      -> CLI)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod FlagFields Bool -> Parser Bool
switch (String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"list" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"List available applications")
    Parser
  (Bool
   -> Bool
   -> Bool
   -> Bool
   -> Maybe Text
   -> Bool
   -> Bool
   -> Bool
   -> [Capabilities -> Capabilities]
   -> Bool
   -> Maybe Text
   -> Maybe Text
   -> [Text]
   -> [Text]
   -> Maybe Text
   -> [Text]
   -> CLI)
-> Parser Bool
-> Parser
     (Bool
      -> Bool
      -> Bool
      -> Maybe Text
      -> Bool
      -> Bool
      -> Bool
      -> [Capabilities -> Capabilities]
      -> Bool
      -> Maybe Text
      -> Maybe Text
      -> [Text]
      -> [Text]
      -> Maybe Text
      -> [Text]
      -> CLI)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch (String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"list-caps" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"List available capabilities")
    Parser
  (Bool
   -> Bool
   -> Bool
   -> Maybe Text
   -> Bool
   -> Bool
   -> Bool
   -> [Capabilities -> Capabilities]
   -> Bool
   -> Maybe Text
   -> Maybe Text
   -> [Text]
   -> [Text]
   -> Maybe Text
   -> [Text]
   -> CLI)
-> Parser Bool
-> Parser
     (Bool
      -> Bool
      -> Maybe Text
      -> Bool
      -> Bool
      -> Bool
      -> [Capabilities -> Capabilities]
      -> Bool
      -> Maybe Text
      -> Maybe Text
      -> [Text]
      -> [Text]
      -> Maybe Text
      -> [Text]
      -> CLI)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch (String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"manifest" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> Mod FlagFields Bool
forall (f :: * -> *) a. Mod f a
hidden)
    Parser
  (Bool
   -> Bool
   -> Maybe Text
   -> Bool
   -> Bool
   -> Bool
   -> [Capabilities -> Capabilities]
   -> Bool
   -> Maybe Text
   -> Maybe Text
   -> [Text]
   -> [Text]
   -> Maybe Text
   -> [Text]
   -> CLI)
-> Parser Bool
-> Parser
     (Bool
      -> Maybe Text
      -> Bool
      -> Bool
      -> Bool
      -> [Capabilities -> Capabilities]
      -> Bool
      -> Maybe Text
      -> Maybe Text
      -> [Text]
      -> [Text]
      -> Maybe Text
      -> [Text]
      -> CLI)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch (String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"dhall-env" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> Mod FlagFields Bool
forall (f :: * -> *) a. Mod f a
hidden)
    Parser
  (Bool
   -> Maybe Text
   -> Bool
   -> Bool
   -> Bool
   -> [Capabilities -> Capabilities]
   -> Bool
   -> Maybe Text
   -> Maybe Text
   -> [Text]
   -> [Text]
   -> Maybe Text
   -> [Text]
   -> CLI)
-> Parser Bool
-> Parser
     (Maybe Text
      -> Bool
      -> Bool
      -> Bool
      -> [Capabilities -> Capabilities]
      -> Bool
      -> Maybe Text
      -> Maybe Text
      -> [Text]
      -> [Text]
      -> Maybe Text
      -> [Text]
      -> CLI)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch (String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"show" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"Show the environment without running it")
    Parser
  (Maybe Text
   -> Bool
   -> Bool
   -> Bool
   -> [Capabilities -> Capabilities]
   -> Bool
   -> Maybe Text
   -> Maybe Text
   -> [Text]
   -> [Text]
   -> Maybe Text
   -> [Text]
   -> CLI)
-> Parser (Maybe Text)
-> Parser
     (Bool
      -> Bool
      -> Bool
      -> [Capabilities -> Capabilities]
      -> Bool
      -> Maybe Text
      -> Maybe Text
      -> [Text]
      -> [Text]
      -> Maybe Text
      -> [Text]
      -> CLI)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text -> Parser (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Mod OptionFields Text -> Parser Text
forall s. IsString s => Mod OptionFields s -> Parser s
strOption (String -> Mod OptionFields Text
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"config" Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Text
forall (f :: * -> *) a. String -> Mod f a
help String
"A config expression"))
    -- runtime env:
    Parser
  (Bool
   -> Bool
   -> Bool
   -> [Capabilities -> Capabilities]
   -> Bool
   -> Maybe Text
   -> Maybe Text
   -> [Text]
   -> [Text]
   -> Maybe Text
   -> [Text]
   -> CLI)
-> Parser Bool
-> Parser
     (Bool
      -> Bool
      -> [Capabilities -> Capabilities]
      -> Bool
      -> Maybe Text
      -> Maybe Text
      -> [Text]
      -> [Text]
      -> Maybe Text
      -> [Text]
      -> CLI)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch (String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"update" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"Update the runtime")
    Parser
  (Bool
   -> Bool
   -> [Capabilities -> Capabilities]
   -> Bool
   -> Maybe Text
   -> Maybe Text
   -> [Text]
   -> [Text]
   -> Maybe Text
   -> [Text]
   -> CLI)
-> Parser Bool
-> Parser
     (Bool
      -> [Capabilities -> Capabilities]
      -> Bool
      -> Maybe Text
      -> Maybe Text
      -> [Text]
      -> [Text]
      -> Maybe Text
      -> [Text]
      -> CLI)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch (String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"verbose" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"Increase verbosity")
    Parser
  (Bool
   -> [Capabilities -> Capabilities]
   -> Bool
   -> Maybe Text
   -> Maybe Text
   -> [Text]
   -> [Text]
   -> Maybe Text
   -> [Text]
   -> CLI)
-> Parser Bool
-> Parser
     ([Capabilities -> Capabilities]
      -> Bool
      -> Maybe Text
      -> Maybe Text
      -> [Text]
      -> [Text]
      -> Maybe Text
      -> [Text]
      -> CLI)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch (String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"detach" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> Mod FlagFields Bool
forall (f :: * -> *) a. Mod f a
hidden)
    -- app modifiers:
    Parser
  ([Capabilities -> Capabilities]
   -> Bool
   -> Maybe Text
   -> Maybe Text
   -> [Text]
   -> [Text]
   -> Maybe Text
   -> [Text]
   -> CLI)
-> Parser [Capabilities -> Capabilities]
-> Parser
     (Bool
      -> Maybe Text
      -> Maybe Text
      -> [Text]
      -> [Text]
      -> Maybe Text
      -> [Text]
      -> CLI)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [Capabilities -> Capabilities]
capsParser
    Parser
  (Bool
   -> Maybe Text
   -> Maybe Text
   -> [Text]
   -> [Text]
   -> Maybe Text
   -> [Text]
   -> CLI)
-> Parser Bool
-> Parser
     (Maybe Text
      -> Maybe Text -> [Text] -> [Text] -> Maybe Text -> [Text] -> CLI)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch (String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"shell" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"Start a shell instead of the application command")
    Parser
  (Maybe Text
   -> Maybe Text -> [Text] -> [Text] -> Maybe Text -> [Text] -> CLI)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text -> [Text] -> [Text] -> Maybe Text -> [Text] -> CLI)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text -> Parser (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Mod OptionFields Text -> Parser Text
forall s. IsString s => Mod OptionFields s -> Parser s
strOption (String -> Mod OptionFields Text
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"namespace" Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Text
forall (f :: * -> *) a. String -> Mod f a
help String
"Share a network ns"))
    Parser
  (Maybe Text -> [Text] -> [Text] -> Maybe Text -> [Text] -> CLI)
-> Parser (Maybe Text)
-> Parser ([Text] -> [Text] -> Maybe Text -> [Text] -> CLI)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text -> Parser (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Mod OptionFields Text -> Parser Text
forall s. IsString s => Mod OptionFields s -> Parser s
strOption (String -> Mod OptionFields Text
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"name" Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Text
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"NAME" Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Text
forall (f :: * -> *) a. String -> Mod f a
help String
"Container name"))
    Parser ([Text] -> [Text] -> Maybe Text -> [Text] -> CLI)
-> Parser [Text] -> Parser ([Text] -> Maybe Text -> [Text] -> CLI)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text -> Parser [Text]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Mod OptionFields Text -> Parser Text
forall s. IsString s => Mod OptionFields s -> Parser s
strOption (String -> Mod OptionFields Text
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"env" Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Text
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"ENV" Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Text
forall (f :: * -> *) a. String -> Mod f a
help String
"Extra env 'KEY=VALUE'"))
    Parser ([Text] -> Maybe Text -> [Text] -> CLI)
-> Parser [Text] -> Parser (Maybe Text -> [Text] -> CLI)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text -> Parser [Text]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Mod OptionFields Text -> Parser Text
forall s. IsString s => Mod OptionFields s -> Parser s
strOption (String -> Mod OptionFields Text
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"volume" Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields Text
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'v' Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Text
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"VOLUME" Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Text
forall (f :: * -> *) a. String -> Mod f a
help String
"Extra volumes 'volume|hostPath[:containerPath]'"))
    Parser (Maybe Text -> [Text] -> CLI)
-> Parser (Maybe Text) -> Parser ([Text] -> CLI)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text -> Parser (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Mod ArgumentFields Text -> Parser Text
forall s. IsString s => Mod ArgumentFields s -> Parser s
strArgument (String -> Mod ArgumentFields Text
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"APP" Mod ArgumentFields Text
-> Mod ArgumentFields Text -> Mod ArgumentFields Text
forall a. Semigroup a => a -> a -> a
<> String -> Mod ArgumentFields Text
forall (f :: * -> *) a. String -> Mod f a
help String
"Application config name or image:name or nix:expr"))
    Parser ([Text] -> CLI) -> Parser [Text] -> Parser CLI
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text -> Parser [Text]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Mod ArgumentFields Text -> Parser Text
forall s. IsString s => Mod ArgumentFields s -> Parser s
strArgument (String -> Mod ArgumentFields Text
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"ARGS" Mod ArgumentFields Text
-> Mod ArgumentFields Text -> Mod ArgumentFields Text
forall a. Semigroup a => a -> a -> a
<> String -> Mod ArgumentFields Text
forall (f :: * -> *) a. String -> Mod f a
help String
"Application args"))

-- | List of strOption that accept an argument (that is not the selector)
strOptions :: [String]
strOptions :: [String]
strOptions = [String
"--config", String
"--namespace", String
"--name", String
"--env", String
"--volume", String
"-v"]

-- | Parse all capabilities toggles
capsParser :: Parser [Capabilities -> Capabilities]
capsParser :: Parser [Capabilities -> Capabilities]
capsParser = [Maybe (Capabilities -> Capabilities)]
-> [Capabilities -> Capabilities]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Capabilities -> Capabilities)]
 -> [Capabilities -> Capabilities])
-> Parser [Maybe (Capabilities -> Capabilities)]
-> Parser [Capabilities -> Capabilities]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Cap -> Parser (Maybe (Capabilities -> Capabilities)))
-> [Cap] -> Parser [Maybe (Capabilities -> Capabilities)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Cap -> Parser (Maybe (Capabilities -> Capabilities))
mkCapParser [Cap]
Podenv.Application.capsAll
  where
    mkCapParser :: Podenv.Application.Cap -> Parser (Maybe (Capabilities -> Capabilities))
    mkCapParser :: Cap -> Parser (Maybe (Capabilities -> Capabilities))
mkCapParser Cap
cap =
      Cap -> Bool -> Parser (Maybe (Capabilities -> Capabilities))
toggleCapParser Cap
cap Bool
True Parser (Maybe (Capabilities -> Capabilities))
-> Parser (Maybe (Capabilities -> Capabilities))
-> Parser (Maybe (Capabilities -> Capabilities))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Cap -> Bool -> Parser (Maybe (Capabilities -> Capabilities))
toggleCapParser Cap
cap Bool
False

-- | A helper function to parse CLI capability toggle
toggleCapParser :: Podenv.Application.Cap -> Bool -> Parser (Maybe (Capabilities -> Capabilities))
toggleCapParser :: Cap -> Bool -> Parser (Maybe (Capabilities -> Capabilities))
toggleCapParser Podenv.Application.Cap {Text
Context -> AppEnvT Context
Lens' Capabilities Bool
$sel:capSet:Cap :: Cap -> Context -> AppEnvT Context
$sel:capLens:Cap :: Cap -> Lens' Capabilities Bool
$sel:capDescription:Cap :: Cap -> Text
$sel:capName:Cap :: Cap -> Text
capSet :: Context -> AppEnvT Context
capLens :: Lens' Capabilities Bool
capDescription :: Text
capName :: Text
..} Bool
isOn = Maybe () -> Maybe (Capabilities -> Capabilities)
setMaybeCap (Maybe () -> Maybe (Capabilities -> Capabilities))
-> Parser (Maybe ())
-> Parser (Maybe (Capabilities -> Capabilities))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Maybe ())
flagParser
  where
    -- We parse a dummy flag from the command line
    flagParser :: Parser (Maybe ())
    flagParser :: Parser (Maybe ())
flagParser = Parser () -> Parser (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (() -> Mod FlagFields () -> Parser ()
forall a. a -> Mod FlagFields a -> Parser a
flag' () (String -> Mod FlagFields ()
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
flagName Mod FlagFields () -> Mod FlagFields () -> Mod FlagFields ()
forall a. Semigroup a => a -> a -> a
<> Mod FlagFields ()
forall (f :: * -> *) a. Mod f a
hidden))
    flagName :: String
flagName = Text -> String
forall a. ToString a => a -> String
toString (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ (if Bool
isOn then Text
"" else Text
"no-") Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
capName

    -- That will be replaced by the setCap when Just ()
    setMaybeCap :: Maybe () -> Maybe (Capabilities -> Capabilities)
    setMaybeCap :: Maybe () -> Maybe (Capabilities -> Capabilities)
setMaybeCap = (() -> Capabilities -> Capabilities)
-> Maybe () -> Maybe (Capabilities -> Capabilities)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Capabilities -> Capabilities)
-> () -> Capabilities -> Capabilities
forall a b. a -> b -> a
const Capabilities -> Capabilities
setCap)
    setCap :: Capabilities -> Capabilities
    setCap :: Capabilities -> Capabilities
setCap = (Bool -> Identity Bool) -> Capabilities -> Identity Capabilities
Lens' Capabilities Bool
capLens ((Bool -> Identity Bool) -> Capabilities -> Identity Capabilities)
-> Bool -> Capabilities -> Capabilities
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
isOn

cliInfo :: ParserInfo CLI
cliInfo :: ParserInfo CLI
cliInfo =
  Parser CLI -> InfoMod CLI -> ParserInfo CLI
forall a. Parser a -> InfoMod a -> ParserInfo a
info
    (Parser (CLI -> CLI)
forall a. Parser (a -> a)
versionOption Parser (CLI -> CLI) -> Parser CLI -> Parser CLI
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser CLI
cliParser Parser CLI -> Parser (CLI -> CLI) -> Parser CLI
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> Parser (CLI -> CLI)
forall a. Parser (a -> a)
helper)
    (InfoMod CLI
forall a. InfoMod a
fullDesc InfoMod CLI -> InfoMod CLI -> InfoMod CLI
forall a. Semigroup a => a -> a -> a
<> String -> InfoMod CLI
forall a. String -> InfoMod a
header String
"podenv - a container wrapper")
  where
    versionOption :: Parser (a -> a)
versionOption =
      String -> Mod OptionFields (a -> a) -> Parser (a -> a)
forall a. String -> Mod OptionFields (a -> a) -> Parser (a -> a)
infoOption
        ([String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [Version -> String
showVersion Version
version, String
" ", String
Podenv.Version.version])
        (String -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"version" Mod OptionFields (a -> a)
-> Mod OptionFields (a -> a) -> Mod OptionFields (a -> a)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. String -> Mod f a
help String
"Show version")

-- | Load the config
cliConfigLoad :: CLI -> IO (Application, Podenv.Application.Mode, Name, RuntimeEnv)
cliConfigLoad :: CLI -> IO (Application, Mode, Name, RuntimeEnv)
cliConfigLoad cli :: CLI
cli@CLI {Bool
[Text]
[Capabilities -> Capabilities]
Maybe Text
cliExtraArgs :: [Text]
selector :: Maybe Text
volumes :: [Text]
cliEnv :: [Text]
name :: Maybe Text
namespace :: Maybe Text
shell :: Bool
capsOverride :: [Capabilities -> Capabilities]
detach :: Bool
verbose :: Bool
update :: Bool
configExpr :: Maybe Text
showApplication :: Bool
showDhallEnv :: Bool
showManifest :: Bool
listCaps :: Bool
listApps :: Bool
cliExtraArgs :: CLI -> [Text]
selector :: CLI -> Maybe Text
volumes :: CLI -> [Text]
cliEnv :: CLI -> [Text]
name :: CLI -> Maybe Text
namespace :: CLI -> Maybe Text
shell :: CLI -> Bool
capsOverride :: CLI -> [Capabilities -> Capabilities]
detach :: CLI -> Bool
verbose :: CLI -> Bool
update :: CLI -> Bool
configExpr :: CLI -> Maybe Text
showApplication :: CLI -> Bool
showDhallEnv :: CLI -> Bool
showManifest :: CLI -> Bool
listCaps :: CLI -> Bool
listApps :: CLI -> Bool
..} = do
  SystemConfig
system <- IO SystemConfig
Podenv.Config.loadSystem
  -- The volumes dir may be provided by the system config, otherwise default to ~/.local/share/podenv/volumes
  String
volumesDir <- case SystemConfig -> Maybe Text
data_volumes_dir SystemConfig
system of
    Just Text
fp -> String -> IO String
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ Text -> String
forall a. ToString a => a -> String
toString Text
fp
    Maybe Text
Nothing -> IO String
getDataDir IO String -> (String -> IO String) -> IO String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \String
fp -> String -> IO String
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ String
fp String -> String -> String
</> String
"volumes"

  Config
config <- Maybe Text -> Maybe Text -> IO Config
Podenv.Config.load Maybe Text
selector Maybe Text
configExpr
  ([Text]
extraArgs, Application
baseApp) <- Either Text ([Text], Application) -> IO ([Text], Application)
forall a. Either Text a -> IO a
mayFail (Either Text ([Text], Application) -> IO ([Text], Application))
-> Either Text ([Text], Application) -> IO ([Text], Application)
forall a b. (a -> b) -> a -> b
$ Config -> [Text] -> Either Text ([Text], Application)
Podenv.Config.select Config
config (Maybe Text -> [Text]
forall a. Maybe a -> [a]
maybeToList Maybe Text
selector [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
cliExtraArgs)
  let app :: Application
app = CLI -> Application -> Application
cliPrepare CLI
cli Application
baseApp
      name' :: Name
name' = Text -> Name
Name (Text -> Name) -> Text -> Name
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe (Application
app Application
-> FoldLike Text Application Application Text Text -> Text
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike Text Application Application Text Text
forall (f :: * -> *).
Functor f =>
(Text -> f Text) -> Application -> f Application
appName) Maybe Text
name
      re :: RuntimeEnv
re = RuntimeEnv :: Bool -> Bool -> SystemConfig -> [Text] -> String -> RuntimeEnv
RuntimeEnv {Bool
$sel:verbose:RuntimeEnv :: Bool
verbose :: Bool
verbose, Bool
$sel:detach:RuntimeEnv :: Bool
detach :: Bool
detach, SystemConfig
$sel:system:RuntimeEnv :: SystemConfig
system :: SystemConfig
system, [Text]
$sel:extraArgs:RuntimeEnv :: [Text]
extraArgs :: [Text]
extraArgs, String
$sel:volumesDir:RuntimeEnv :: String
volumesDir :: String
volumesDir}
      mode :: Mode
mode = if Bool
shell then Mode
Podenv.Application.Shell else Mode
Podenv.Application.Regular
  (Application, Mode, Name, RuntimeEnv)
-> IO (Application, Mode, Name, RuntimeEnv)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Application
app, Mode
mode, Name
name', RuntimeEnv
re)

-- | Apply the CLI argument to the application
cliPrepare :: CLI -> Application -> Application
cliPrepare :: CLI -> Application -> Application
cliPrepare CLI {Bool
[Text]
[Capabilities -> Capabilities]
Maybe Text
cliExtraArgs :: [Text]
selector :: Maybe Text
volumes :: [Text]
cliEnv :: [Text]
name :: Maybe Text
namespace :: Maybe Text
shell :: Bool
capsOverride :: [Capabilities -> Capabilities]
detach :: Bool
verbose :: Bool
update :: Bool
configExpr :: Maybe Text
showApplication :: Bool
showDhallEnv :: Bool
showManifest :: Bool
listCaps :: Bool
listApps :: Bool
cliExtraArgs :: CLI -> [Text]
selector :: CLI -> Maybe Text
volumes :: CLI -> [Text]
cliEnv :: CLI -> [Text]
name :: CLI -> Maybe Text
namespace :: CLI -> Maybe Text
shell :: CLI -> Bool
capsOverride :: CLI -> [Capabilities -> Capabilities]
detach :: CLI -> Bool
verbose :: CLI -> Bool
update :: CLI -> Bool
configExpr :: CLI -> Maybe Text
showApplication :: CLI -> Bool
showDhallEnv :: CLI -> Bool
showManifest :: CLI -> Bool
listCaps :: CLI -> Bool
listApps :: CLI -> Bool
..} = Application -> Application
setShell (Application -> Application)
-> (Application -> Application) -> Application -> Application
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Application -> Application
setEnvs (Application -> Application)
-> (Application -> Application) -> Application -> Application
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Application -> Application
setVolumes (Application -> Application)
-> (Application -> Application) -> Application -> Application
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Application -> Application
setCaps (Application -> Application)
-> (Application -> Application) -> Application -> Application
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Application -> Application
setNS
  where
    setNS :: Application -> Application
setNS = (Application -> Application)
-> (Text -> Application -> Application)
-> Maybe Text
-> Application
-> Application
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Application -> Application
forall a. a -> a
id ((Maybe Text -> Identity (Maybe Text))
-> Application -> Identity Application
forall (f :: * -> *).
Functor f =>
(Maybe Text -> f (Maybe Text)) -> Application -> f Application
appNamespace ((Maybe Text -> Identity (Maybe Text))
 -> Application -> Identity Application)
-> Text -> Application -> Application
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~) Maybe Text
namespace

    setShell :: Application -> Application
setShell = (Application -> Application)
-> (Application -> Application)
-> Bool
-> Application
-> Application
forall a. a -> a -> Bool -> a
bool Application -> Application
forall a. a -> a
id Application -> Application
setShellCap Bool
shell
    setShellCap :: Application -> Application
setShellCap = (Capabilities -> Identity Capabilities)
-> Application -> Identity Application
forall (f :: * -> *).
Functor f =>
(Capabilities -> f Capabilities) -> Application -> f Application
appCapabilities ((Capabilities -> Identity Capabilities)
 -> Application -> Identity Application)
-> (Capabilities -> Capabilities) -> Application -> Application
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ((Bool -> Identity Bool) -> Capabilities -> Identity Capabilities
Lens' Capabilities Bool
capTerminal ((Bool -> Identity Bool) -> Capabilities -> Identity Capabilities)
-> Bool -> Capabilities -> Capabilities
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
True) (Capabilities -> Capabilities)
-> (Capabilities -> Capabilities) -> Capabilities -> Capabilities
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Bool -> Identity Bool) -> Capabilities -> Identity Capabilities
Lens' Capabilities Bool
capInteractive ((Bool -> Identity Bool) -> Capabilities -> Identity Capabilities)
-> Bool -> Capabilities -> Capabilities
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
True)

    setEnvs :: Application -> Application
setEnvs Application
app' = (Text -> Application -> Application)
-> Application -> [Text] -> Application
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Text
v -> ([Text] -> Identity [Text]) -> Application -> Identity Application
forall (f :: * -> *).
Functor f =>
([Text] -> f [Text]) -> Application -> f Application
appEnviron (([Text] -> Identity [Text])
 -> Application -> Identity Application)
-> ([Text] -> [Text]) -> Application -> Application
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Text
v Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:)) Application
app' [Text]
cliEnv

    setVolumes :: Application -> Application
setVolumes Application
app' = (Text -> Application -> Application)
-> Application -> [Text] -> Application
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Text
v -> ([Text] -> Identity [Text]) -> Application -> Identity Application
forall (f :: * -> *).
Functor f =>
([Text] -> f [Text]) -> Application -> f Application
appVolumes (([Text] -> Identity [Text])
 -> Application -> Identity Application)
-> ([Text] -> [Text]) -> Application -> Application
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Text
v Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:)) Application
app' [Text]
volumes

    setCaps :: Application -> Application
setCaps Application
app' = ((Capabilities -> Capabilities) -> Application -> Application)
-> Application -> [Capabilities -> Capabilities] -> Application
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((Capabilities -> Identity Capabilities)
-> Application -> Identity Application
forall (f :: * -> *).
Functor f =>
(Capabilities -> f Capabilities) -> Application -> f Application
appCapabilities ((Capabilities -> Identity Capabilities)
 -> Application -> Identity Application)
-> (Capabilities -> Capabilities) -> Application -> Application
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~) Application
app' [Capabilities -> Capabilities]
capsOverride

showApp :: Application -> Context -> Podenv.Build.BuildEnv -> RuntimeEnv -> Text
showApp :: Application -> Context -> BuildEnv -> RuntimeEnv -> Text
showApp Application {[Text]
Maybe Text
Text
Runtime
Capabilities
$sel:volumes:Application :: Application -> [Text]
$sel:syscaps:Application :: Application -> [Text]
$sel:runtime:Application :: Application -> Runtime
$sel:namespace:Application :: Application -> Maybe Text
$sel:name:Application :: Application -> Text
$sel:environ:Application :: Application -> [Text]
$sel:description:Application :: Application -> Maybe Text
$sel:command:Application :: Application -> [Text]
$sel:capabilities:Application :: Application -> Capabilities
volumes :: [Text]
syscaps :: [Text]
runtime :: Runtime
namespace :: Maybe Text
name :: Text
environ :: [Text]
description :: Maybe Text
command :: [Text]
capabilities :: Capabilities
..} Context
ctx BuildEnv
be RuntimeEnv
re = [Text] -> Text
forall t. IsText t "unlines" => [t] -> t
unlines [Text]
infos
  where
    infos :: [Text]
infos =
      [Text
"[+] runtime: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> BuildEnv -> Text
Podenv.Build.beInfos BuildEnv
be, Text
""]
        [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text
"[+] Capabilities", [Text] -> Text
forall t. IsText t "unwords" => [t] -> t
unwords ([Text] -> [Text]
forall a. Ord a => [a] -> [a]
sort [Text]
appCaps), Text
""]
        [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text
"[+] Command", Text
cmd]
    cmd :: Text
cmd = RuntimeEnv -> Context -> Text
Podenv.Runtime.showRuntimeCmd RuntimeEnv
re Context
ctx
    appCaps :: [Text]
appCaps = (Cap -> [Text]) -> [Cap] -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Cap -> [Text]
showCap [Cap]
Podenv.Application.capsAll
    showCap :: Cap -> [Text]
showCap Podenv.Application.Cap {Text
Context -> AppEnvT Context
Lens' Capabilities Bool
capSet :: Context -> AppEnvT Context
capLens :: Lens' Capabilities Bool
capDescription :: Text
capName :: Text
$sel:capSet:Cap :: Cap -> Context -> AppEnvT Context
$sel:capLens:Cap :: Cap -> Lens' Capabilities Bool
$sel:capDescription:Cap :: Cap -> Text
$sel:capName:Cap :: Cap -> Text
..} =
      [Text
capName | Capabilities
capabilities Capabilities
-> FoldLike Bool Capabilities Capabilities Bool Bool -> Bool
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike Bool Capabilities Capabilities Bool Bool
Lens' Capabilities Bool
capLens]

printCaps :: IO ()
printCaps :: IO ()
printCaps = do
  Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putText (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall t. IsText t "unlines" => [t] -> t
unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> [Text]
forall a. Ord a => [a] -> [a]
sort ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ (Cap -> Text) -> [Cap] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Cap -> Text
showCap [Cap]
Podenv.Application.capsAll
  where
    showCap :: Cap -> Text
showCap Podenv.Application.Cap {Text
Context -> AppEnvT Context
Lens' Capabilities Bool
capSet :: Context -> AppEnvT Context
capLens :: Lens' Capabilities Bool
capDescription :: Text
capName :: Text
$sel:capSet:Cap :: Cap -> Context -> AppEnvT Context
$sel:capLens:Cap :: Cap -> Lens' Capabilities Bool
$sel:capDescription:Cap :: Cap -> Text
$sel:capName:Cap :: Cap -> Text
..} =
      let sep :: Text
sep = if Text -> Int
Data.Text.length Text
capName Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
8 then Text
"\t\t" else Text
"\t"
       in Text
capName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
sep Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
capDescription

printApps :: Maybe Text -> IO ()
printApps :: Maybe Text -> IO ()
printApps Maybe Text
configTxt = do
  [(Text, Atom)]
atoms <- Config -> [(Text, Atom)]
configToAtoms (Config -> [(Text, Atom)]) -> IO Config -> IO [(Text, Atom)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text -> Maybe Text -> IO Config
Podenv.Config.load Maybe Text
forall a. Maybe a
Nothing Maybe Text
configTxt
  let showApp' :: ApplicationRecord -> Text
showApp' (Podenv.Config.ApplicationRecord Application
app) =
        Text
"Application" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> (Text -> Text) -> Maybe Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (\Text
desc -> Text
" (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
desc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")") (Application
app Application
-> FoldLike
     (Maybe Text) Application Application (Maybe Text) (Maybe Text)
-> Maybe Text
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike
  (Maybe Text) Application Application (Maybe Text) (Maybe Text)
forall (f :: * -> *).
Functor f =>
(Maybe Text -> f (Maybe Text)) -> Application -> f Application
appDescription)
      showFunc :: Text -> ApplicationRecord -> Text
showFunc Text
args ApplicationRecord
app = Text
"λ " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
args Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" → " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ApplicationRecord -> Text
showApp' ApplicationRecord
app
      showArg :: a -> a
showArg a
a = a
"<" a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a -> a
forall b a. (Show a, IsString b) => a -> b
show a
a a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
">"
      showConfig :: Atom -> Text
showConfig = \case
        Podenv.Config.Lit ApplicationRecord
app -> ApplicationRecord -> Text
showApp' ApplicationRecord
app
        Podenv.Config.LamArg ArgName
name Text -> ApplicationRecord
f -> Text -> ApplicationRecord -> Text
showFunc (ArgName -> Text
forall b a. (Show a, IsString b) => a -> b
show ArgName
name) (Text -> ApplicationRecord
f (ArgName -> Text
forall a a. (Semigroup a, IsString a, Show a) => a -> a
showArg ArgName
name))
        Podenv.Config.LamArg2 ArgName
n1 ArgName
n2 Text -> Text -> ApplicationRecord
f -> Text -> ApplicationRecord -> Text
showFunc (ArgName -> Text
forall b a. (Show a, IsString b) => a -> b
show ArgName
n1 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ArgName -> Text
forall b a. (Show a, IsString b) => a -> b
show ArgName
n2) (Text -> Text -> ApplicationRecord
f (ArgName -> Text
forall a a. (Semigroup a, IsString a, Show a) => a -> a
showArg ArgName
n1) (ArgName -> Text
forall a a. (Semigroup a, IsString a, Show a) => a -> a
showArg ArgName
n2))
        Podenv.Config.LamApp Application -> ApplicationRecord
_ -> Text
"λ app → app"
      showAtom :: (Text, Atom) -> Text
showAtom (Text
name, Atom
app) = Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Atom -> Text
showConfig Atom
app
  ((Text, Atom) -> IO ()) -> [(Text, Atom)] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putTextLn (Text -> IO ()) -> ((Text, Atom) -> Text) -> (Text, Atom) -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Atom) -> Text
showAtom) [(Text, Atom)]
atoms

configToAtoms :: Podenv.Config.Config -> [(Text, Podenv.Config.Atom)]
configToAtoms :: Config -> [(Text, Atom)]
configToAtoms = \case
  Podenv.Config.ConfigDefault ApplicationRecord
ar -> [(Text
"default", ApplicationRecord -> Atom
Podenv.Config.Lit ApplicationRecord
ar)]
  Podenv.Config.ConfigApplication Atom
atom -> [(Text
"default", Atom
atom)]
  Podenv.Config.ConfigApplications [(Text, Atom)]
xs -> ((Text, Atom) -> Text) -> [(Text, Atom)] -> [(Text, Atom)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Text, Atom) -> Text
forall a b. (a, b) -> a
fst [(Text, Atom)]
xs

printManifest :: Maybe Text -> IO ()
printManifest :: Maybe Text -> IO ()
printManifest Maybe Text
configTxt = do
  [(Text, Atom)]
atoms <- Config -> [(Text, Atom)]
configToAtoms (Config -> [(Text, Atom)]) -> IO Config -> IO [(Text, Atom)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text -> Maybe Text -> IO Config
Podenv.Config.load Maybe Text
forall a. Maybe a
Nothing Maybe Text
configTxt
  let re :: RuntimeEnv
re = String -> RuntimeEnv
Podenv.Runtime.defaultRuntimeEnv String
"/volume"
      addNL :: Text -> Text
addNL = Text -> Text -> Text -> Text
Data.Text.replace Text
"--" Text
"\\\n  --"
      doPrint :: Text -> AppRunner
doPrint Text
name Application
ar = do
        Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putTextLn Text
name
        (BuildEnv
be, Application
app) <- RuntimeEnv -> Application -> IO (BuildEnv, Application)
Podenv.Build.prepare RuntimeEnv
re Application
ar
        Context
ctx <- Mode -> Application -> Name -> IO Context
Podenv.Application.prepare (Mode
Podenv.Application.Regular) Application
app (Text -> Name
Name Text
name)
        Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putTextLn (Text -> IO ()) -> (Text -> Text) -> Text -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
addNL (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Application -> Context -> BuildEnv -> RuntimeEnv -> Text
showApp Application
app Context
ctx BuildEnv
be RuntimeEnv
re

      printAppContext :: (Text, Podenv.Config.Atom) -> IO ()
      printAppContext :: (Text, Atom) -> IO ()
printAppContext (Text
name, Atom
atom) = case Atom
atom of
        Podenv.Config.Lit ApplicationRecord
app -> Text -> AppRunner
doPrint Text
name (ApplicationRecord -> Application
Podenv.Config.unRecord ApplicationRecord
app)
        Podenv.Config.LamArg ArgName
_ Text -> ApplicationRecord
f -> Text -> AppRunner
doPrint Text
name (ApplicationRecord -> Application
Podenv.Config.unRecord (ApplicationRecord -> Application)
-> ApplicationRecord -> Application
forall a b. (a -> b) -> a -> b
$ Text -> ApplicationRecord
f Text
"a")
        Podenv.Config.LamArg2 ArgName
_ ArgName
_ Text -> Text -> ApplicationRecord
f -> Text -> AppRunner
doPrint Text
name (ApplicationRecord -> Application
Podenv.Config.unRecord (ApplicationRecord -> Application)
-> ApplicationRecord -> Application
forall a b. (a -> b) -> a -> b
$ Text -> Text -> ApplicationRecord
f Text
"a" Text
"b")
        Podenv.Config.LamApp Application -> ApplicationRecord
_ -> Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putTextLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": lamapp"
  ((Text, Atom) -> IO ()) -> [(Text, Atom)] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ ((Text, Atom) -> IO ()
printAppContext) [(Text, Atom)]
atoms