-- | @futhark pkg@
module Futhark.CLI.Pkg (main) where

import Codec.Archive.Zip qualified as Zip
import Control.Monad.IO.Class
import Control.Monad.Reader
import Control.Monad.State
import Data.ByteString.Lazy qualified as LBS
import Data.List (intercalate, isPrefixOf)
import Data.Map qualified as M
import Data.Maybe
import Data.Monoid
import Data.Text qualified as T
import Data.Text.IO qualified as T
import Futhark.Pkg.Info
import Futhark.Pkg.Solve
import Futhark.Pkg.Types
import Futhark.Util (directoryContents, maxinum)
import Futhark.Util.Log
import Futhark.Util.Options
import System.Directory
import System.Environment
import System.Exit
import System.FilePath
import System.FilePath.Posix qualified as Posix
import System.IO
import Prelude

--- Installing packages

installInDir :: BuildList -> FilePath -> PkgM ()
installInDir :: BuildList -> String -> PkgM ()
installInDir (BuildList Map Text SemVer
bl) String
dir = do
  let putEntry :: String -> String -> Entry -> IO (Maybe String)
putEntry String
from_dir String
pdir Entry
entry
        -- The archive may contain all kinds of other stuff that we don't want.
        | Bool -> Bool
not (String -> String -> Bool
isInPkgDir String
from_dir forall a b. (a -> b) -> a -> b
$ Entry -> String
Zip.eRelativePath Entry
entry)
            Bool -> Bool -> Bool
|| String -> Bool
hasTrailingPathSeparator (Entry -> String
Zip.eRelativePath Entry
entry) =
            forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
        | Bool
otherwise = do
            -- Since we are writing to paths indicated in a zipfile we
            -- downloaded from the wild Internet, we are going to be a
            -- little bit paranoid.  Specifically, we want to avoid
            -- writing outside of the 'lib/' directory.  We do this by
            -- bailing out if the path contains any '..' components.  We
            -- have to use System.FilePath.Posix, because the zip library
            -- claims to encode filepaths with '/' directory seperators no
            -- matter the host OS.
            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String
".." forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String -> [String]
Posix.splitPath (Entry -> String
Zip.eRelativePath Entry
entry)) forall a b. (a -> b) -> a -> b
$
              forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$
                String
"Zip archive for "
                  forall a. Semigroup a => a -> a -> a
<> String
pdir
                  forall a. Semigroup a => a -> a -> a
<> String
" contains suspicious path: "
                  forall a. Semigroup a => a -> a -> a
<> Entry -> String
Zip.eRelativePath Entry
entry
            let f :: String
f = String
pdir String -> String -> String
</> String -> String -> String
makeRelative String
from_dir (Entry -> String
Zip.eRelativePath Entry
entry)
            Bool -> String -> IO ()
createDirectoryIfMissing Bool
True forall a b. (a -> b) -> a -> b
$ String -> String
takeDirectory String
f
            String -> ByteString -> IO ()
LBS.writeFile String
f forall a b. (a -> b) -> a -> b
$ Entry -> ByteString
Zip.fromEntry Entry
entry
            forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just String
f

      isInPkgDir :: String -> String -> Bool
isInPkgDir String
from_dir String
f =
        String -> [String]
Posix.splitPath String
from_dir forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String -> [String]
Posix.splitPath String
f

  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall k a. Map k a -> [(k, a)]
M.toList Map Text SemVer
bl) forall a b. (a -> b) -> a -> b
$ \(Text
p, SemVer
v) -> do
    PkgRevInfo PkgM
info <- forall (m :: * -> *).
MonadPkgRegistry m =>
Text -> SemVer -> m (PkgRevInfo m)
lookupPackageRev Text
p SemVer
v
    Archive
a <- forall (m :: * -> *).
(MonadLogger m, MonadIO m, MonadFail m) =>
PkgRevInfo m -> m Archive
downloadZipball PkgRevInfo PkgM
info
    PkgManifest
m <- forall (m :: * -> *). GetManifest m -> m PkgManifest
getManifest forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). PkgRevInfo m -> GetManifest m
pkgRevGetManifest PkgRevInfo PkgM
info

    -- Compute the directory in the zipball that should contain the
    -- package files.
    let noPkgDir :: PkgM a
noPkgDir =
          forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$
            String
"futhark.pkg for "
              forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
p
              forall a. [a] -> [a] -> [a]
++ String
"-"
              forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack (SemVer -> Text
prettySemVer SemVer
v)
              forall a. [a] -> [a] -> [a]
++ String
" does not define a package path."
    String
from_dir <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall {a}. PkgM a
noPkgDir (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (m :: * -> *). PkgRevInfo m -> String
pkgRevZipballDir PkgRevInfo PkgM
info <>)) forall a b. (a -> b) -> a -> b
$ PkgManifest -> Maybe String
pkgDir PkgManifest
m

    -- The directory in the local file system that will contain the
    -- package files.
    let pdir :: String
pdir = String
dir String -> String -> String
</> Text -> String
T.unpack Text
p
    -- Remove any existing directory for this package.  This is a bit
    -- inefficient, as the likelihood that the old ``lib`` directory
    -- already contains the correct version is rather high.  We should
    -- have a way to recognise this situation, and not download the
    -- zipball in that case.
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO ()
removePathForcibly String
pdir
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Bool -> String -> IO ()
createDirectoryIfMissing Bool
True String
pdir

    [String]
written <-
      forall a. [Maybe a] -> [a]
catMaybes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (String -> String -> Entry -> IO (Maybe String)
putEntry String
from_dir String
pdir) forall a b. (a -> b) -> a -> b
$ Archive -> [Entry]
Zip.zEntries Archive
a)

    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
written) forall a b. (a -> b) -> a -> b
$
      forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$
        String
"Zip archive for package "
          forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
p
          forall a. [a] -> [a] -> [a]
++ String
" does not contain any files in "
          forall a. [a] -> [a] -> [a]
++ String
from_dir

libDir, libNewDir, libOldDir :: FilePath
(String
libDir, String
libNewDir, String
libOldDir) = (String
"lib", String
"lib~new", String
"lib~old")

-- | Install the packages listed in the build list in the @lib@
-- directory of the current working directory.  Since we are touching
-- the file system, we are going to be very paranoid.  In particular,
-- we want to avoid corrupting the @lib@ directory if something fails
-- along the way.
--
-- The procedure is as follows:
--
-- 1) Create a directory @lib~new@.  Delete an existing @lib~new@ if
-- necessary.
--
-- 2) Populate @lib~new@ based on the build list.
--
-- 3) Rename @lib@ to @lib~old@.  Delete an existing @lib~old@ if
-- necessary.
--
-- 4) Rename @lib~new@ to @lib@
--
-- 5) If the current package has package path @p@, move @lib~old/p@ to
-- @lib~new/p@.
--
-- 6) Delete @lib~old@.
--
-- Since POSIX at least guarantees atomic renames, the only place this
-- can fail is between steps 3, 4, and 5.  In that case, at least the
-- @lib~old@ will still exist and can be put back by the user.
installBuildList :: Maybe PkgPath -> BuildList -> PkgM ()
installBuildList :: Maybe Text -> BuildList -> PkgM ()
installBuildList Maybe Text
p BuildList
bl = do
  Bool
libdir_exists <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO Bool
doesDirectoryExist String
libDir

  -- 1
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
    String -> IO ()
removePathForcibly String
libNewDir
    Bool -> String -> IO ()
createDirectoryIfMissing Bool
False String
libNewDir

  -- 2
  BuildList -> String -> PkgM ()
installInDir BuildList
bl String
libNewDir

  -- 3
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
libdir_exists forall a b. (a -> b) -> a -> b
$
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
      String -> IO ()
removePathForcibly String
libOldDir
      String -> String -> IO ()
renameDirectory String
libDir String
libOldDir

  -- 4
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> String -> IO ()
renameDirectory String
libNewDir String
libDir

  -- 5
  case Text -> String
pkgPathFilePath forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
p of
    Just String
pfp | Bool
libdir_exists -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
      Bool
pkgdir_exists <- String -> IO Bool
doesDirectoryExist forall a b. (a -> b) -> a -> b
$ String
libOldDir String -> String -> String
</> String
pfp
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
pkgdir_exists forall a b. (a -> b) -> a -> b
$ do
        -- Ensure the parent directories exist so that we can move the
        -- package directory directly.
        Bool -> String -> IO ()
createDirectoryIfMissing Bool
True forall a b. (a -> b) -> a -> b
$ String -> String
takeDirectory forall a b. (a -> b) -> a -> b
$ String
libDir String -> String -> String
</> String
pfp
        String -> String -> IO ()
renameDirectory (String
libOldDir String -> String -> String
</> String
pfp) (String
libDir String -> String -> String
</> String
pfp)
    Maybe String
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

  -- 6
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
libdir_exists forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO ()
removePathForcibly String
libOldDir

getPkgManifest :: PkgM PkgManifest
getPkgManifest :: PkgM PkgManifest
getPkgManifest = do
  Bool
file_exists <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO Bool
doesFileExist String
futharkPkg
  Bool
dir_exists <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO Bool
doesDirectoryExist String
futharkPkg

  case (Bool
file_exists, Bool
dir_exists) of
    (Bool
True, Bool
_) -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO PkgManifest
parsePkgManifestFromFile String
futharkPkg
    (Bool
_, Bool
True) ->
      forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$
        String
futharkPkg
          forall a. Semigroup a => a -> a -> a
<> String
" exists, but it is a directory!  What in Odin's beard..."
    (Bool, Bool)
_ -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
      Text -> IO ()
T.putStrLn forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
futharkPkg forall a. Semigroup a => a -> a -> a
<> Text
" not found - pretending it's empty."
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Maybe Text -> PkgManifest
newPkgManifest forall a. Maybe a
Nothing

putPkgManifest :: PkgManifest -> PkgM ()
putPkgManifest :: PkgManifest -> PkgM ()
putPkgManifest = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text -> IO ()
T.writeFile String
futharkPkg forall b c a. (b -> c) -> (a -> b) -> a -> c
. PkgManifest -> Text
prettyPkgManifest

--- The CLI

newtype PkgConfig = PkgConfig {PkgConfig -> Bool
pkgVerbose :: Bool}

-- | The monad in which futhark-pkg runs.
newtype PkgM a = PkgM {forall a.
PkgM a -> ReaderT PkgConfig (StateT (PkgRegistry PkgM) IO) a
unPkgM :: ReaderT PkgConfig (StateT (PkgRegistry PkgM) IO) a}
  deriving (forall a b. a -> PkgM b -> PkgM a
forall a b. (a -> b) -> PkgM a -> PkgM 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 -> PkgM b -> PkgM a
$c<$ :: forall a b. a -> PkgM b -> PkgM a
fmap :: forall a b. (a -> b) -> PkgM a -> PkgM b
$cfmap :: forall a b. (a -> b) -> PkgM a -> PkgM b
Functor, Functor PkgM
forall a. a -> PkgM a
forall a b. PkgM a -> PkgM b -> PkgM a
forall a b. PkgM a -> PkgM b -> PkgM b
forall a b. PkgM (a -> b) -> PkgM a -> PkgM b
forall a b c. (a -> b -> c) -> PkgM a -> PkgM b -> PkgM 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. PkgM a -> PkgM b -> PkgM a
$c<* :: forall a b. PkgM a -> PkgM b -> PkgM a
*> :: forall a b. PkgM a -> PkgM b -> PkgM b
$c*> :: forall a b. PkgM a -> PkgM b -> PkgM b
liftA2 :: forall a b c. (a -> b -> c) -> PkgM a -> PkgM b -> PkgM c
$cliftA2 :: forall a b c. (a -> b -> c) -> PkgM a -> PkgM b -> PkgM c
<*> :: forall a b. PkgM (a -> b) -> PkgM a -> PkgM b
$c<*> :: forall a b. PkgM (a -> b) -> PkgM a -> PkgM b
pure :: forall a. a -> PkgM a
$cpure :: forall a. a -> PkgM a
Applicative, Monad PkgM
forall a. IO a -> PkgM a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: forall a. IO a -> PkgM a
$cliftIO :: forall a. IO a -> PkgM a
MonadIO, MonadReader PkgConfig)

instance Monad PkgM where
  PkgM ReaderT PkgConfig (StateT (PkgRegistry PkgM) IO) a
m >>= :: forall a b. PkgM a -> (a -> PkgM b) -> PkgM b
>>= a -> PkgM b
f = forall a.
ReaderT PkgConfig (StateT (PkgRegistry PkgM) IO) a -> PkgM a
PkgM forall a b. (a -> b) -> a -> b
$ ReaderT PkgConfig (StateT (PkgRegistry PkgM) IO) a
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a.
PkgM a -> ReaderT PkgConfig (StateT (PkgRegistry PkgM) IO) a
unPkgM forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> PkgM b
f

instance MonadFail PkgM where
  fail :: forall a. String -> PkgM a
fail String
s = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
    String
prog <- IO String
getProgName
    String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ String
prog forall a. [a] -> [a] -> [a]
++ String
": " forall a. [a] -> [a] -> [a]
++ String
s
    forall a. IO a
exitFailure

instance MonadPkgRegistry PkgM where
  putPkgRegistry :: PkgRegistry PkgM -> PkgM ()
putPkgRegistry = forall a.
ReaderT PkgConfig (StateT (PkgRegistry PkgM) IO) a -> PkgM a
PkgM forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *). MonadState s m => s -> m ()
put
  getPkgRegistry :: PkgM (PkgRegistry PkgM)
getPkgRegistry = forall a.
ReaderT PkgConfig (StateT (PkgRegistry PkgM) IO) a -> PkgM a
PkgM forall s (m :: * -> *). MonadState s m => m s
get

instance MonadLogger PkgM where
  addLog :: Log -> PkgM ()
addLog Log
l = do
    Bool
verbose <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks PkgConfig -> Bool
pkgVerbose
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
verbose forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Handle -> Text -> IO ()
T.hPutStrLn Handle
stderr forall a b. (a -> b) -> a -> b
$ Log -> Text
toText Log
l

runPkgM :: PkgConfig -> PkgM a -> IO a
runPkgM :: forall a. PkgConfig -> PkgM a -> IO a
runPkgM PkgConfig
cfg (PkgM ReaderT PkgConfig (StateT (PkgRegistry PkgM) IO) a
m) = forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT PkgConfig (StateT (PkgRegistry PkgM) IO) a
m PkgConfig
cfg) forall a. Monoid a => a
mempty

cmdMain ::
  String ->
  ([String] -> PkgConfig -> Maybe (IO ())) ->
  String ->
  [String] ->
  IO ()
cmdMain :: String
-> ([String] -> PkgConfig -> Maybe (IO ()))
-> String
-> [String]
-> IO ()
cmdMain = forall cfg.
cfg
-> [FunOptDescr cfg]
-> String
-> ([String] -> cfg -> Maybe (IO ()))
-> String
-> [String]
-> IO ()
mainWithOptions (Bool -> PkgConfig
PkgConfig Bool
False) forall {a}. [OptDescr (Either a (PkgConfig -> PkgConfig))]
options
  where
    options :: [OptDescr (Either a (PkgConfig -> PkgConfig))]
options =
      [ forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
          String
"v"
          [String
"verbose"]
          (forall a. a -> ArgDescr a
NoArg forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ \PkgConfig
cfg -> PkgConfig
cfg {pkgVerbose :: Bool
pkgVerbose = Bool
True})
          String
"Write running diagnostics to stderr."
      ]

doFmt :: String -> [String] -> IO ()
doFmt :: String -> [String] -> IO ()
doFmt = forall cfg.
cfg
-> [FunOptDescr cfg]
-> String
-> ([String] -> cfg -> Maybe (IO ()))
-> String
-> [String]
-> IO ()
mainWithOptions () [] String
"" forall a b. (a -> b) -> a -> b
$ \[String]
args () ->
  case [String]
args of
    [] -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ do
      PkgManifest
m <- String -> IO PkgManifest
parsePkgManifestFromFile String
futharkPkg
      String -> Text -> IO ()
T.writeFile String
futharkPkg forall a b. (a -> b) -> a -> b
$ PkgManifest -> Text
prettyPkgManifest PkgManifest
m
    [String]
_ -> forall a. Maybe a
Nothing

doCheck :: String -> [String] -> IO ()
doCheck :: String -> [String] -> IO ()
doCheck = String
-> ([String] -> PkgConfig -> Maybe (IO ()))
-> String
-> [String]
-> IO ()
cmdMain String
"check" forall a b. (a -> b) -> a -> b
$ \[String]
args PkgConfig
cfg ->
  case [String]
args of
    [] -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$
      forall a. PkgConfig -> PkgM a -> IO a
runPkgM PkgConfig
cfg forall a b. (a -> b) -> a -> b
$ do
        PkgManifest
m <- PkgM PkgManifest
getPkgManifest
        BuildList
bl <- forall (m :: * -> *).
MonadPkgRegistry m =>
PkgRevDeps -> m BuildList
solveDeps forall a b. (a -> b) -> a -> b
$ PkgManifest -> PkgRevDeps
pkgRevDeps PkgManifest
m

        forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Text -> IO ()
T.putStrLn Text
"Dependencies chosen:"
        forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Text -> IO ()
T.putStr forall a b. (a -> b) -> a -> b
$ BuildList -> Text
prettyBuildList BuildList
bl

        case forall a. Commented a -> a
commented forall a b. (a -> b) -> a -> b
$ PkgManifest -> Commented (Maybe Text)
manifestPkgPath PkgManifest
m of
          Maybe Text
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          Just Text
p -> do
            let pdir :: String
pdir = String
"lib" String -> String -> String
</> Text -> String
T.unpack Text
p

            Bool
pdir_exists <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO Bool
doesDirectoryExist String
pdir

            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
pdir_exists forall a b. (a -> b) -> a -> b
$
              forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
                Text -> IO ()
T.putStrLn forall a b. (a -> b) -> a -> b
$ Text
"Problem: the directory " forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
pdir forall a. Semigroup a => a -> a -> a
<> Text
" does not exist."
                forall a. IO a
exitFailure

            Bool
anything <-
              forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
                forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((forall a. Eq a => a -> a -> Bool
== String
".fut") forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
takeExtension)
                  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO [String]
directoryContents (String
"lib" String -> String -> String
</> Text -> String
T.unpack Text
p)
            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
anything forall a b. (a -> b) -> a -> b
$
              forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
                Text -> IO ()
T.putStrLn forall a b. (a -> b) -> a -> b
$ Text
"Problem: the directory " forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
pdir forall a. Semigroup a => a -> a -> a
<> Text
" does not contain any .fut files."
                forall a. IO a
exitFailure
    [String]
_ -> forall a. Maybe a
Nothing

doSync :: String -> [String] -> IO ()
doSync :: String -> [String] -> IO ()
doSync = String
-> ([String] -> PkgConfig -> Maybe (IO ()))
-> String
-> [String]
-> IO ()
cmdMain String
"" forall a b. (a -> b) -> a -> b
$ \[String]
args PkgConfig
cfg ->
  case [String]
args of
    [] -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$
      forall a. PkgConfig -> PkgM a -> IO a
runPkgM PkgConfig
cfg forall a b. (a -> b) -> a -> b
$ do
        PkgManifest
m <- PkgM PkgManifest
getPkgManifest
        BuildList
bl <- forall (m :: * -> *).
MonadPkgRegistry m =>
PkgRevDeps -> m BuildList
solveDeps forall a b. (a -> b) -> a -> b
$ PkgManifest -> PkgRevDeps
pkgRevDeps PkgManifest
m
        Maybe Text -> BuildList -> PkgM ()
installBuildList (forall a. Commented a -> a
commented forall a b. (a -> b) -> a -> b
$ PkgManifest -> Commented (Maybe Text)
manifestPkgPath PkgManifest
m) BuildList
bl
    [String]
_ -> forall a. Maybe a
Nothing

doAdd :: String -> [String] -> IO ()
doAdd :: String -> [String] -> IO ()
doAdd = String
-> ([String] -> PkgConfig -> Maybe (IO ()))
-> String
-> [String]
-> IO ()
cmdMain String
"PKGPATH" forall a b. (a -> b) -> a -> b
$ \[String]
args PkgConfig
cfg ->
  case [String]
args of
    [String
p, String
v] | Right SemVer
v' <- Text -> Either (ParseErrorBundle Text Void) SemVer
parseVersion forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
v -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. PkgConfig -> PkgM a -> IO a
runPkgM PkgConfig
cfg forall a b. (a -> b) -> a -> b
$ Text -> SemVer -> PkgM ()
doAdd' (String -> Text
T.pack String
p) SemVer
v'
    [String
p] ->
      forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$
        forall a. PkgConfig -> PkgM a -> IO a
runPkgM PkgConfig
cfg forall a b. (a -> b) -> a -> b
$
          -- Look up the newest revision of the package.
          Text -> SemVer -> PkgM ()
doAdd' (String -> Text
T.pack String
p) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). MonadPkgRegistry m => Text -> m SemVer
lookupNewestRev (String -> Text
T.pack String
p)
    [String]
_ -> forall a. Maybe a
Nothing
  where
    doAdd' :: Text -> SemVer -> PkgM ()
doAdd' Text
p SemVer
v = do
      PkgManifest
m <- PkgM PkgManifest
getPkgManifest

      -- See if this package (and its dependencies) even exists.  We
      -- do this by running the solver with the dependencies already
      -- in the manifest, plus this new one.  The Monoid instance for
      -- PkgRevDeps is left-biased, so we are careful to use the new
      -- version for this package.
      BuildList
_ <- forall (m :: * -> *).
MonadPkgRegistry m =>
PkgRevDeps -> m BuildList
solveDeps forall a b. (a -> b) -> a -> b
$ Map Text (SemVer, Maybe Text) -> PkgRevDeps
PkgRevDeps (forall k a. k -> a -> Map k a
M.singleton Text
p (SemVer
v, forall a. Maybe a
Nothing)) forall a. Semigroup a => a -> a -> a
<> PkgManifest -> PkgRevDeps
pkgRevDeps PkgManifest
m

      -- We either replace any existing occurence of package 'p', or
      -- we add a new one.
      PkgRevInfo PkgM
p_info <- forall (m :: * -> *).
MonadPkgRegistry m =>
Text -> SemVer -> m (PkgRevInfo m)
lookupPackageRev Text
p SemVer
v
      let hash :: Maybe Text
hash = case (SemVer -> Word
_svMajor SemVer
v, SemVer -> Word
_svMinor SemVer
v, SemVer -> Word
_svPatch SemVer
v) of
            -- We do not perform hash-pinning for
            -- (0,0,0)-versions, because these already embed a
            -- specific revision ID into their version number.
            (Word
0, Word
0, Word
0) -> forall a. Maybe a
Nothing
            (Word, Word, Word)
_ -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). PkgRevInfo m -> Text
pkgRevCommit PkgRevInfo PkgM
p_info
          req :: Required
req = Text -> SemVer -> Maybe Text -> Required
Required Text
p SemVer
v Maybe Text
hash
          (PkgManifest
m', Maybe Required
prev_r) = Required -> PkgManifest -> (PkgManifest, Maybe Required)
addRequiredToManifest Required
req PkgManifest
m

      case Maybe Required
prev_r of
        Just Required
prev_r'
          | Required -> SemVer
requiredPkgRev Required
prev_r' forall a. Eq a => a -> a -> Bool
== SemVer
v ->
              forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Text -> IO ()
T.putStrLn forall a b. (a -> b) -> a -> b
$ Text
"Package already at version " forall a. Semigroup a => a -> a -> a
<> SemVer -> Text
prettySemVer SemVer
v forall a. Semigroup a => a -> a -> a
<> Text
"; nothing to do."
          | Bool
otherwise ->
              forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
                Text -> IO ()
T.putStrLn forall a b. (a -> b) -> a -> b
$
                  Text
"Replaced "
                    forall a. Semigroup a => a -> a -> a
<> Text
p
                    forall a. Semigroup a => a -> a -> a
<> Text
" "
                    forall a. Semigroup a => a -> a -> a
<> SemVer -> Text
prettySemVer (Required -> SemVer
requiredPkgRev Required
prev_r')
                    forall a. Semigroup a => a -> a -> a
<> Text
" => "
                    forall a. Semigroup a => a -> a -> a
<> SemVer -> Text
prettySemVer SemVer
v
                    forall a. Semigroup a => a -> a -> a
<> Text
"."
        Maybe Required
Nothing ->
          forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Text -> IO ()
T.putStrLn forall a b. (a -> b) -> a -> b
$ Text
"Added new required package " forall a. Semigroup a => a -> a -> a
<> Text
p forall a. Semigroup a => a -> a -> a
<> Text
" " forall a. Semigroup a => a -> a -> a
<> SemVer -> Text
prettySemVer SemVer
v forall a. Semigroup a => a -> a -> a
<> Text
"."
      PkgManifest -> PkgM ()
putPkgManifest PkgManifest
m'
      forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Text -> IO ()
T.putStrLn Text
"Remember to run 'futhark pkg sync'."

doRemove :: String -> [String] -> IO ()
doRemove :: String -> [String] -> IO ()
doRemove = String
-> ([String] -> PkgConfig -> Maybe (IO ()))
-> String
-> [String]
-> IO ()
cmdMain String
"PKGPATH" forall a b. (a -> b) -> a -> b
$ \[String]
args PkgConfig
cfg ->
  case [String]
args of
    [String
p] -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. PkgConfig -> PkgM a -> IO a
runPkgM PkgConfig
cfg forall a b. (a -> b) -> a -> b
$ Text -> PkgM ()
doRemove' forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
p
    [String]
_ -> forall a. Maybe a
Nothing
  where
    doRemove' :: Text -> PkgM ()
doRemove' Text
p = do
      PkgManifest
m <- PkgM PkgManifest
getPkgManifest
      case Text -> PkgManifest -> Maybe (PkgManifest, Required)
removeRequiredFromManifest Text
p PkgManifest
m of
        Maybe (PkgManifest, Required)
Nothing -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
          Text -> IO ()
T.putStrLn forall a b. (a -> b) -> a -> b
$ Text
"No package " forall a. Semigroup a => a -> a -> a
<> Text
p forall a. Semigroup a => a -> a -> a
<> Text
" found in " forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
futharkPkg forall a. Semigroup a => a -> a -> a
<> Text
"."
          forall a. IO a
exitFailure
        Just (PkgManifest
m', Required
r) -> do
          PkgManifest -> PkgM ()
putPkgManifest PkgManifest
m'
          forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Text -> IO ()
T.putStrLn forall a b. (a -> b) -> a -> b
$ Text
"Removed " forall a. Semigroup a => a -> a -> a
<> Text
p forall a. Semigroup a => a -> a -> a
<> Text
" " forall a. Semigroup a => a -> a -> a
<> SemVer -> Text
prettySemVer (Required -> SemVer
requiredPkgRev Required
r) forall a. Semigroup a => a -> a -> a
<> Text
"."

doInit :: String -> [String] -> IO ()
doInit :: String -> [String] -> IO ()
doInit = String
-> ([String] -> PkgConfig -> Maybe (IO ()))
-> String
-> [String]
-> IO ()
cmdMain String
"PKGPATH" forall a b. (a -> b) -> a -> b
$ \[String]
args PkgConfig
cfg ->
  case [String]
args of
    [String
p] -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. PkgConfig -> PkgM a -> IO a
runPkgM PkgConfig
cfg forall a b. (a -> b) -> a -> b
$ Text -> PkgM ()
doCreate' forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
p
    [String]
_ -> forall a. Maybe a
Nothing
  where
    validPkgPath :: Text -> Bool
validPkgPath Text
p =
      Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
".", String
".."]) forall a b. (a -> b) -> a -> b
$ String -> [String]
splitDirectories forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
p

    doCreate' :: Text -> PkgM ()
doCreate' Text
p = do
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text -> Bool
validPkgPath Text
p) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
        Text -> IO ()
T.putStrLn forall a b. (a -> b) -> a -> b
$ Text
"Not a valid package path: " forall a. Semigroup a => a -> a -> a
<> Text
p
        Text -> IO ()
T.putStrLn Text
"Note: package paths are usually URIs."
        Text -> IO ()
T.putStrLn Text
"Note: 'futhark init' is only needed when creating a package, not to use packages."
        forall a. IO a
exitFailure

      Bool
exists <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> Bool
(||) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO Bool
doesFileExist String
futharkPkg forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> IO Bool
doesDirectoryExist String
futharkPkg
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
exists forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
          Text -> IO ()
T.putStrLn forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
futharkPkg forall a. Semigroup a => a -> a -> a
<> Text
" already exists."
          forall a. IO a
exitFailure

      forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Bool -> String -> IO ()
createDirectoryIfMissing Bool
True forall a b. (a -> b) -> a -> b
$ String
"lib" String -> String -> String
</> Text -> String
T.unpack Text
p
      forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Text -> IO ()
T.putStrLn forall a b. (a -> b) -> a -> b
$ Text
"Created directory " forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (String
"lib" String -> String -> String
</> Text -> String
T.unpack Text
p) forall a. Semigroup a => a -> a -> a
<> Text
"."

      PkgManifest -> PkgM ()
putPkgManifest forall a b. (a -> b) -> a -> b
$ Maybe Text -> PkgManifest
newPkgManifest forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Text
p
      forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Text -> IO ()
T.putStrLn forall a b. (a -> b) -> a -> b
$ Text
"Wrote " forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
futharkPkg forall a. Semigroup a => a -> a -> a
<> Text
"."

doUpgrade :: String -> [String] -> IO ()
doUpgrade :: String -> [String] -> IO ()
doUpgrade = String
-> ([String] -> PkgConfig -> Maybe (IO ()))
-> String
-> [String]
-> IO ()
cmdMain String
"" forall a b. (a -> b) -> a -> b
$ \[String]
args PkgConfig
cfg ->
  case [String]
args of
    [] -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$
      forall a. PkgConfig -> PkgM a -> IO a
runPkgM PkgConfig
cfg forall a b. (a -> b) -> a -> b
$ do
        PkgManifest
m <- PkgM PkgManifest
getPkgManifest
        Commented [Either Text Required]
rs <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall {m :: * -> *}. MonadPkgRegistry m => Required -> m Required
upgrade)) forall a b. (a -> b) -> a -> b
$ PkgManifest -> Commented [Either Text Required]
manifestRequire PkgManifest
m
        PkgManifest -> PkgM ()
putPkgManifest PkgManifest
m {manifestRequire :: Commented [Either Text Required]
manifestRequire = Commented [Either Text Required]
rs}
        if Commented [Either Text Required]
rs forall a. Eq a => a -> a -> Bool
== PkgManifest -> Commented [Either Text Required]
manifestRequire PkgManifest
m
          then forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Text -> IO ()
T.putStrLn Text
"Nothing to upgrade."
          else forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Text -> IO ()
T.putStrLn Text
"Remember to run 'futhark pkg sync'."
    [String]
_ -> forall a. Maybe a
Nothing
  where
    upgrade :: Required -> m Required
upgrade Required
req = do
      SemVer
v <- forall (m :: * -> *). MonadPkgRegistry m => Text -> m SemVer
lookupNewestRev forall a b. (a -> b) -> a -> b
$ Required -> Text
requiredPkg Required
req
      Text
h <- forall (m :: * -> *). PkgRevInfo m -> Text
pkgRevCommit forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
MonadPkgRegistry m =>
Text -> SemVer -> m (PkgRevInfo m)
lookupPackageRev (Required -> Text
requiredPkg Required
req) SemVer
v

      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (SemVer
v forall a. Eq a => a -> a -> Bool
/= Required -> SemVer
requiredPkgRev Required
req) forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
          Text -> IO ()
T.putStrLn forall a b. (a -> b) -> a -> b
$
            Text
"Upgraded "
              forall a. Semigroup a => a -> a -> a
<> Required -> Text
requiredPkg Required
req
              forall a. Semigroup a => a -> a -> a
<> Text
" "
              forall a. Semigroup a => a -> a -> a
<> SemVer -> Text
prettySemVer (Required -> SemVer
requiredPkgRev Required
req)
              forall a. Semigroup a => a -> a -> a
<> Text
" => "
              forall a. Semigroup a => a -> a -> a
<> SemVer -> Text
prettySemVer SemVer
v
              forall a. Semigroup a => a -> a -> a
<> Text
"."

      forall (f :: * -> *) a. Applicative f => a -> f a
pure
        Required
req
          { requiredPkgRev :: SemVer
requiredPkgRev = SemVer
v,
            requiredHash :: Maybe Text
requiredHash = forall a. a -> Maybe a
Just Text
h
          }

doVersions :: String -> [String] -> IO ()
doVersions :: String -> [String] -> IO ()
doVersions = String
-> ([String] -> PkgConfig -> Maybe (IO ()))
-> String
-> [String]
-> IO ()
cmdMain String
"PKGPATH" forall a b. (a -> b) -> a -> b
$ \[String]
args PkgConfig
cfg ->
  case [String]
args of
    [String
p] -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. PkgConfig -> PkgM a -> IO a
runPkgM PkgConfig
cfg forall a b. (a -> b) -> a -> b
$ Text -> PkgM ()
doVersions' forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
p
    [String]
_ -> forall a. Maybe a
Nothing
  where
    doVersions' :: Text -> PkgM ()
doVersions' =
      forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> IO ()
T.putStrLn forall b c a. (b -> c) -> (a -> b) -> a -> c
. SemVer -> Text
prettySemVer) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [k]
M.keys forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). PkgInfo m -> Map SemVer (PkgRevInfo m)
pkgVersions
        forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall (m :: * -> *). MonadPkgRegistry m => Text -> m (PkgInfo m)
lookupPackage

-- | Run @futhark pkg@.
main :: String -> [String] -> IO ()
main :: String -> [String] -> IO ()
main String
prog [String]
args = do
  -- Avoid Git asking for credentials.  We prefer failure.
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> String -> IO ()
setEnv String
"GIT_TERMINAL_PROMPT" String
"0"

  let commands :: [(String, (String -> [String] -> IO (), Text))]
commands =
        [ ( String
"add",
            (String -> [String] -> IO ()
doAdd, Text
"Add another required package to futhark.pkg.")
          ),
          ( String
"check",
            (String -> [String] -> IO ()
doCheck, Text
"Check that futhark.pkg is satisfiable.")
          ),
          ( String
"init",
            (String -> [String] -> IO ()
doInit, Text
"Create a new futhark.pkg and a lib/ skeleton.")
          ),
          ( String
"fmt",
            (String -> [String] -> IO ()
doFmt, Text
"Reformat futhark.pkg.")
          ),
          ( String
"sync",
            (String -> [String] -> IO ()
doSync, Text
"Populate lib/ as specified by futhark.pkg.")
          ),
          ( String
"remove",
            (String -> [String] -> IO ()
doRemove, Text
"Remove a required package from futhark.pkg.")
          ),
          ( String
"upgrade",
            (String -> [String] -> IO ()
doUpgrade, Text
"Upgrade all packages to newest versions.")
          ),
          ( String
"versions",
            (String -> [String] -> IO ()
doVersions, Text
"List available versions for a package.")
          )
        ]
      usage :: String
usage = String
"options... <" forall a. Semigroup a => a -> a -> a
<> forall a. [a] -> [[a]] -> [a]
intercalate String
"|" (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(String, (String -> [String] -> IO (), Text))]
commands) forall a. Semigroup a => a -> a -> a
<> String
">"
  case [String]
args of
    String
cmd : [String]
args'
      | Just (String -> [String] -> IO ()
m, Text
_) <- forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
cmd [(String, (String -> [String] -> IO (), Text))]
commands ->
          String -> [String] -> IO ()
m ([String] -> String
unwords [String
prog, String
cmd]) [String]
args'
    [String]
_ -> do
      let bad :: p -> () -> Maybe (IO b)
bad p
_ () = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ do
            let k :: Int
k = forall a (f :: * -> *). (Num a, Ord a, Foldable f) => f a -> a
maxinum (forall a b. (a -> b) -> [a] -> [b]
map (forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(String, (String -> [String] -> IO (), Text))]
commands) forall a. Num a => a -> a -> a
+ Int
3
            forall {b}. Text -> IO b
usageMsg forall a b. (a -> b) -> a -> b
$
              [Text] -> Text
T.unlines forall a b. (a -> b) -> a -> b
$
                [Text
"<command> ...:", Text
"", Text
"Commands:"]
                  forall a. [a] -> [a] -> [a]
++ [ Text
"   " forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
cmd forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (forall a. Int -> a -> [a]
replicate (Int
k forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length String
cmd) Char
' ') forall a. Semigroup a => a -> a -> a
<> Text
desc
                       | (String
cmd, (String -> [String] -> IO ()
_, Text
desc)) <- [(String, (String -> [String] -> IO (), Text))]
commands
                     ]

      forall cfg.
cfg
-> [FunOptDescr cfg]
-> String
-> ([String] -> cfg -> Maybe (IO ()))
-> String
-> [String]
-> IO ()
mainWithOptions () [] String
usage forall {p} {b}. p -> () -> Maybe (IO b)
bad String
prog [String]
args
  where
    usageMsg :: Text -> IO b
usageMsg Text
s = do
      Text -> IO ()
T.putStrLn forall a b. (a -> b) -> a -> b
$ Text
"Usage: " forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
prog forall a. Semigroup a => a -> a -> a
<> Text
" [--version] [--help] " forall a. Semigroup a => a -> a -> a
<> Text
s
      forall a. IO a
exitFailure