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

import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Reader
import Control.Monad.State
import Data.List (intercalate)
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.IO
import System.IO.Temp (withSystemTempDirectory)
import Prelude

--- Installing packages

installInDir :: CacheDir -> BuildList -> FilePath -> PkgM ()
installInDir :: CacheDir -> BuildList -> String -> PkgM ()
installInDir CacheDir
cachedir (BuildList Map Text SemVer
bl) String
dir =
  [(Text, SemVer)] -> ((Text, SemVer) -> PkgM ()) -> PkgM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Map Text SemVer -> [(Text, SemVer)]
forall k a. Map k a -> [(k, a)]
M.toList Map Text SemVer
bl) (((Text, SemVer) -> PkgM ()) -> PkgM ())
-> ((Text, SemVer) -> PkgM ()) -> PkgM ()
forall a b. (a -> b) -> a -> b
$ \(Text
p, SemVer
v) -> do
    PkgRevInfo PkgM
info <- CacheDir -> Text -> SemVer -> PkgM (PkgRevInfo PkgM)
forall (m :: * -> *).
MonadPkgRegistry m =>
CacheDir -> Text -> SemVer -> m (PkgRevInfo m)
lookupPackageRev CacheDir
cachedir Text
p SemVer
v
    (String
filedir, [String]
files) <- GetFiles PkgM -> PkgM (String, [String])
forall (m :: * -> *). GetFiles m -> m (String, [String])
getFiles (GetFiles PkgM -> PkgM (String, [String]))
-> GetFiles PkgM -> PkgM (String, [String])
forall a b. (a -> b) -> a -> b
$ PkgRevInfo PkgM -> GetFiles PkgM
forall (m :: * -> *). PkgRevInfo m -> GetFiles m
pkgGetFiles PkgRevInfo PkgM
info

    -- 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.
    IO () -> PkgM ()
forall a. IO a -> PkgM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PkgM ()) -> IO () -> PkgM ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
removePathForcibly String
pdir

    [String] -> (String -> PkgM ()) -> PkgM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [String]
files ((String -> PkgM ()) -> PkgM ()) -> (String -> PkgM ()) -> PkgM ()
forall a b. (a -> b) -> a -> b
$ \String
file -> do
      let from :: String
from = String
filedir String -> String -> String
</> String
file
          to :: String
to = String
pdir String -> String -> String
</> String
file
      IO () -> PkgM ()
forall a. IO a -> PkgM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PkgM ()) -> IO () -> PkgM ()
forall a b. (a -> b) -> a -> b
$ Bool -> String -> IO ()
createDirectoryIfMissing Bool
True (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String
takeDirectory String
to
      String -> PkgM ()
forall a. ToLog a => a -> PkgM ()
forall (m :: * -> *) a. (MonadLogger m, ToLog a) => a -> m ()
logMsg (String -> PkgM ()) -> String -> PkgM ()
forall a b. (a -> b) -> a -> b
$ String
"Copying " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
from String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\n" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"to      " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
to
      IO () -> PkgM ()
forall a. IO a -> PkgM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PkgM ()) -> IO () -> PkgM ()
forall a b. (a -> b) -> a -> b
$ String -> String -> IO ()
copyFile String
from String
to

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 :: CacheDir -> Maybe PkgPath -> BuildList -> PkgM ()
installBuildList :: CacheDir -> Maybe Text -> BuildList -> PkgM ()
installBuildList CacheDir
cachedir Maybe Text
p BuildList
bl = do
  Bool
libdir_exists <- IO Bool -> PkgM Bool
forall a. IO a -> PkgM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> PkgM Bool) -> IO Bool -> PkgM Bool
forall a b. (a -> b) -> a -> b
$ String -> IO Bool
doesDirectoryExist String
libDir

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

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

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

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

  -- 5
  case Text -> String
pkgPathFilePath (Text -> String) -> Maybe Text -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
p of
    Just String
pfp | Bool
libdir_exists -> IO () -> PkgM ()
forall a. IO a -> PkgM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PkgM ()) -> IO () -> PkgM ()
forall a b. (a -> b) -> a -> b
$ do
      Bool
pkgdir_exists <- String -> IO Bool
doesDirectoryExist (String -> IO Bool) -> String -> IO Bool
forall a b. (a -> b) -> a -> b
$ String
libOldDir String -> String -> String
</> String
pfp
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
pkgdir_exists (IO () -> IO ()) -> IO () -> IO ()
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 (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String
takeDirectory (String -> String) -> String -> String
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
_ -> () -> PkgM ()
forall a. a -> PkgM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

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

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

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

putPkgManifest :: PkgManifest -> PkgM ()
putPkgManifest :: PkgManifest -> PkgM ()
putPkgManifest = IO () -> PkgM ()
forall a. IO a -> PkgM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PkgM ())
-> (PkgManifest -> IO ()) -> PkgManifest -> PkgM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text -> IO ()
T.writeFile String
futharkPkg (Text -> IO ()) -> (PkgManifest -> Text) -> PkgManifest -> IO ()
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 -> b) -> PkgM a -> PkgM b)
-> (forall a b. a -> PkgM b -> PkgM a) -> Functor PkgM
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
$cfmap :: forall a b. (a -> b) -> PkgM a -> PkgM b
fmap :: forall a b. (a -> b) -> PkgM a -> PkgM b
$c<$ :: forall a b. a -> PkgM b -> PkgM a
<$ :: forall a b. a -> PkgM b -> PkgM a
Functor, Functor PkgM
Functor PkgM
-> (forall a. a -> PkgM a)
-> (forall a b. PkgM (a -> b) -> PkgM a -> PkgM b)
-> (forall a b c. (a -> b -> c) -> PkgM a -> PkgM b -> PkgM c)
-> (forall a b. PkgM a -> PkgM b -> PkgM b)
-> (forall a b. PkgM a -> PkgM b -> PkgM a)
-> Applicative 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
$cpure :: forall a. a -> PkgM a
pure :: forall a. a -> PkgM a
$c<*> :: forall a b. PkgM (a -> b) -> PkgM a -> PkgM b
<*> :: forall a b. PkgM (a -> b) -> PkgM a -> PkgM b
$cliftA2 :: forall a b c. (a -> b -> c) -> PkgM a -> PkgM b -> PkgM c
liftA2 :: forall a b c. (a -> b -> c) -> PkgM a -> PkgM b -> PkgM c
$c*> :: forall a b. PkgM a -> PkgM b -> PkgM b
*> :: forall a b. PkgM a -> PkgM b -> PkgM b
$c<* :: forall a b. PkgM a -> PkgM b -> PkgM a
<* :: forall a b. PkgM a -> PkgM b -> PkgM a
Applicative, Monad PkgM
Monad PkgM -> (forall a. IO a -> PkgM a) -> MonadIO PkgM
forall a. IO a -> PkgM a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
$cliftIO :: forall a. IO a -> PkgM a
liftIO :: 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 = ReaderT PkgConfig (StateT (PkgRegistry PkgM) IO) b -> PkgM b
forall a.
ReaderT PkgConfig (StateT (PkgRegistry PkgM) IO) a -> PkgM a
PkgM (ReaderT PkgConfig (StateT (PkgRegistry PkgM) IO) b -> PkgM b)
-> ReaderT PkgConfig (StateT (PkgRegistry PkgM) IO) b -> PkgM b
forall a b. (a -> b) -> a -> b
$ ReaderT PkgConfig (StateT (PkgRegistry PkgM) IO) a
m ReaderT PkgConfig (StateT (PkgRegistry PkgM) IO) a
-> (a -> ReaderT PkgConfig (StateT (PkgRegistry PkgM) IO) b)
-> ReaderT PkgConfig (StateT (PkgRegistry PkgM) IO) b
forall a b.
ReaderT PkgConfig (StateT (PkgRegistry PkgM) IO) a
-> (a -> ReaderT PkgConfig (StateT (PkgRegistry PkgM) IO) b)
-> ReaderT PkgConfig (StateT (PkgRegistry PkgM) IO) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PkgM b -> ReaderT PkgConfig (StateT (PkgRegistry PkgM) IO) b
forall a.
PkgM a -> ReaderT PkgConfig (StateT (PkgRegistry PkgM) IO) a
unPkgM (PkgM b -> ReaderT PkgConfig (StateT (PkgRegistry PkgM) IO) b)
-> (a -> PkgM b)
-> a
-> ReaderT PkgConfig (StateT (PkgRegistry PkgM) IO) b
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 = IO a -> PkgM a
forall a. IO a -> PkgM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> PkgM a) -> IO a -> PkgM a
forall a b. (a -> b) -> a -> b
$ do
    String
prog <- IO String
getProgName
    String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
prog String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s
    IO a
forall a. IO a
exitFailure

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

instance MonadLogger PkgM where
  addLog :: Log -> PkgM ()
addLog Log
l = do
    Bool
verbose <- (PkgConfig -> Bool) -> PkgM Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks PkgConfig -> Bool
pkgVerbose
    Bool -> PkgM () -> PkgM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
verbose (PkgM () -> PkgM ()) -> PkgM () -> PkgM ()
forall a b. (a -> b) -> a -> b
$ IO () -> PkgM ()
forall a. IO a -> PkgM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PkgM ()) -> IO () -> PkgM ()
forall a b. (a -> b) -> a -> b
$ Handle -> Text -> IO ()
T.hPutStrLn Handle
stderr (Text -> IO ()) -> Text -> IO ()
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) = StateT (PkgRegistry PkgM) IO a -> PkgRegistry PkgM -> IO a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (ReaderT PkgConfig (StateT (PkgRegistry PkgM) IO) a
-> PkgConfig -> StateT (PkgRegistry PkgM) IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT PkgConfig (StateT (PkgRegistry PkgM) IO) a
m PkgConfig
cfg) PkgRegistry PkgM
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 = PkgConfig
-> [FunOptDescr PkgConfig]
-> String
-> ([String] -> PkgConfig -> Maybe (IO ()))
-> String
-> [String]
-> IO ()
forall cfg.
cfg
-> [FunOptDescr cfg]
-> String
-> ([String] -> cfg -> Maybe (IO ()))
-> String
-> [String]
-> IO ()
mainWithOptions (Bool -> PkgConfig
PkgConfig Bool
False) [FunOptDescr PkgConfig]
forall {a}. [OptDescr (Either a (PkgConfig -> PkgConfig))]
options
  where
    options :: [OptDescr (Either a (PkgConfig -> PkgConfig))]
options =
      [ String
-> [String]
-> ArgDescr (Either a (PkgConfig -> PkgConfig))
-> String
-> OptDescr (Either a (PkgConfig -> PkgConfig))
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
          String
"v"
          [String
"verbose"]
          (Either a (PkgConfig -> PkgConfig)
-> ArgDescr (Either a (PkgConfig -> PkgConfig))
forall a. a -> ArgDescr a
NoArg (Either a (PkgConfig -> PkgConfig)
 -> ArgDescr (Either a (PkgConfig -> PkgConfig)))
-> Either a (PkgConfig -> PkgConfig)
-> ArgDescr (Either a (PkgConfig -> PkgConfig))
forall a b. (a -> b) -> a -> b
$ (PkgConfig -> PkgConfig) -> Either a (PkgConfig -> PkgConfig)
forall a b. b -> Either a b
Right ((PkgConfig -> PkgConfig) -> Either a (PkgConfig -> PkgConfig))
-> (PkgConfig -> PkgConfig) -> Either a (PkgConfig -> PkgConfig)
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 = ()
-> [FunOptDescr ()]
-> String
-> ([String] -> () -> Maybe (IO ()))
-> String
-> [String]
-> IO ()
forall cfg.
cfg
-> [FunOptDescr cfg]
-> String
-> ([String] -> cfg -> Maybe (IO ()))
-> String
-> [String]
-> IO ()
mainWithOptions () [] String
"" (([String] -> () -> Maybe (IO ())) -> String -> [String] -> IO ())
-> ([String] -> () -> Maybe (IO ())) -> String -> [String] -> IO ()
forall a b. (a -> b) -> a -> b
$ \[String]
args () ->
  case [String]
args of
    [] -> IO () -> Maybe (IO ())
forall a. a -> Maybe a
Just (IO () -> Maybe (IO ())) -> IO () -> Maybe (IO ())
forall a b. (a -> b) -> a -> b
$ do
      PkgManifest
m <- String -> IO PkgManifest
parsePkgManifestFromFile String
futharkPkg
      String -> Text -> IO ()
T.writeFile String
futharkPkg (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ PkgManifest -> Text
prettyPkgManifest PkgManifest
m
    [String]
_ -> Maybe (IO ())
forall a. Maybe a
Nothing

withCacheDir :: (CacheDir -> IO a) -> IO a
withCacheDir :: forall a. (CacheDir -> IO a) -> IO a
withCacheDir CacheDir -> IO a
f = String -> (String -> IO a) -> IO a
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
String -> (String -> m a) -> m a
withSystemTempDirectory String
"futhark-pkg" ((String -> IO a) -> IO a) -> (String -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ CacheDir -> IO a
f (CacheDir -> IO a) -> (String -> CacheDir) -> String -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> CacheDir
CacheDir

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

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

      case Commented (Maybe Text) -> Maybe Text
forall a. Commented a -> a
commented (Commented (Maybe Text) -> Maybe Text)
-> Commented (Maybe Text) -> Maybe Text
forall a b. (a -> b) -> a -> b
$ PkgManifest -> Commented (Maybe Text)
manifestPkgPath PkgManifest
m of
        Maybe Text
Nothing -> () -> PkgM ()
forall a. a -> PkgM a
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 <- IO Bool -> PkgM Bool
forall a. IO a -> PkgM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> PkgM Bool) -> IO Bool -> PkgM Bool
forall a b. (a -> b) -> a -> b
$ String -> IO Bool
doesDirectoryExist String
pdir

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

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

doSync :: String -> [String] -> IO ()
doSync :: String -> [String] -> IO ()
doSync = String
-> ([String] -> PkgConfig -> Maybe (IO ()))
-> String
-> [String]
-> IO ()
cmdMain String
"" (([String] -> PkgConfig -> Maybe (IO ()))
 -> String -> [String] -> IO ())
-> ([String] -> PkgConfig -> Maybe (IO ()))
-> String
-> [String]
-> IO ()
forall a b. (a -> b) -> a -> b
$ \[String]
args PkgConfig
cfg ->
  case [String]
args of
    [] -> IO () -> Maybe (IO ())
forall a. a -> Maybe a
Just (IO () -> Maybe (IO ()))
-> ((CacheDir -> IO ()) -> IO ())
-> (CacheDir -> IO ())
-> Maybe (IO ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CacheDir -> IO ()) -> IO ()
forall a. (CacheDir -> IO a) -> IO a
withCacheDir ((CacheDir -> IO ()) -> Maybe (IO ()))
-> (CacheDir -> IO ()) -> Maybe (IO ())
forall a b. (a -> b) -> a -> b
$ \CacheDir
cachedir -> PkgConfig -> PkgM () -> IO ()
forall a. PkgConfig -> PkgM a -> IO a
runPkgM PkgConfig
cfg (PkgM () -> IO ()) -> PkgM () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
      PkgManifest
m <- PkgM PkgManifest
getPkgManifest
      BuildList
bl <- CacheDir -> PkgRevDeps -> PkgM BuildList
forall (m :: * -> *).
MonadPkgRegistry m =>
CacheDir -> PkgRevDeps -> m BuildList
solveDeps CacheDir
cachedir (PkgRevDeps -> PkgM BuildList) -> PkgRevDeps -> PkgM BuildList
forall a b. (a -> b) -> a -> b
$ PkgManifest -> PkgRevDeps
pkgRevDeps PkgManifest
m
      CacheDir -> Maybe Text -> BuildList -> PkgM ()
installBuildList CacheDir
cachedir (Commented (Maybe Text) -> Maybe Text
forall a. Commented a -> a
commented (Commented (Maybe Text) -> Maybe Text)
-> Commented (Maybe Text) -> Maybe Text
forall a b. (a -> b) -> a -> b
$ PkgManifest -> Commented (Maybe Text)
manifestPkgPath PkgManifest
m) BuildList
bl
    [String]
_ -> Maybe (IO ())
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" (([String] -> PkgConfig -> Maybe (IO ()))
 -> String -> [String] -> IO ())
-> ([String] -> PkgConfig -> Maybe (IO ()))
-> String
-> [String]
-> IO ()
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 (Text -> Either (ParseErrorBundle Text Void) SemVer)
-> Text -> Either (ParseErrorBundle Text Void) SemVer
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
v ->
          IO () -> Maybe (IO ())
forall a. a -> Maybe a
Just (IO () -> Maybe (IO ())) -> IO () -> Maybe (IO ())
forall a b. (a -> b) -> a -> b
$ (CacheDir -> IO ()) -> IO ()
forall a. (CacheDir -> IO a) -> IO a
withCacheDir ((CacheDir -> IO ()) -> IO ()) -> (CacheDir -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CacheDir
cachedir ->
            PkgConfig -> PkgM () -> IO ()
forall a. PkgConfig -> PkgM a -> IO a
runPkgM PkgConfig
cfg (PkgM () -> IO ()) -> PkgM () -> IO ()
forall a b. (a -> b) -> a -> b
$ CacheDir -> Text -> SemVer -> PkgM ()
doAdd' CacheDir
cachedir (String -> Text
T.pack String
p) SemVer
v'
    [String
p] ->
      IO () -> Maybe (IO ())
forall a. a -> Maybe a
Just (IO () -> Maybe (IO ())) -> IO () -> Maybe (IO ())
forall a b. (a -> b) -> a -> b
$ (CacheDir -> IO ()) -> IO ()
forall a. (CacheDir -> IO a) -> IO a
withCacheDir ((CacheDir -> IO ()) -> IO ()) -> (CacheDir -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CacheDir
cachedir ->
        PkgConfig -> PkgM () -> IO ()
forall a. PkgConfig -> PkgM a -> IO a
runPkgM PkgConfig
cfg (PkgM () -> IO ()) -> PkgM () -> IO ()
forall a b. (a -> b) -> a -> b
$
          -- Look up the newest revision of the package.
          CacheDir -> Text -> SemVer -> PkgM ()
doAdd' CacheDir
cachedir (String -> Text
T.pack String
p) (SemVer -> PkgM ()) -> PkgM SemVer -> PkgM ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< CacheDir -> Text -> PkgM SemVer
forall (m :: * -> *).
MonadPkgRegistry m =>
CacheDir -> Text -> m SemVer
lookupNewestRev CacheDir
cachedir (String -> Text
T.pack String
p)
    [String]
_ -> Maybe (IO ())
forall a. Maybe a
Nothing
  where
    doAdd' :: CacheDir -> Text -> SemVer -> PkgM ()
doAdd' CacheDir
cachedir 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
_ <- CacheDir -> PkgRevDeps -> PkgM BuildList
forall (m :: * -> *).
MonadPkgRegistry m =>
CacheDir -> PkgRevDeps -> m BuildList
solveDeps CacheDir
cachedir (PkgRevDeps -> PkgM BuildList) -> PkgRevDeps -> PkgM BuildList
forall a b. (a -> b) -> a -> b
$ Map Text (SemVer, Maybe Text) -> PkgRevDeps
PkgRevDeps (Text -> (SemVer, Maybe Text) -> Map Text (SemVer, Maybe Text)
forall k a. k -> a -> Map k a
M.singleton Text
p (SemVer
v, Maybe Text
forall a. Maybe a
Nothing)) PkgRevDeps -> PkgRevDeps -> PkgRevDeps
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 <- CacheDir -> Text -> SemVer -> PkgM (PkgRevInfo PkgM)
forall (m :: * -> *).
MonadPkgRegistry m =>
CacheDir -> Text -> SemVer -> m (PkgRevInfo m)
lookupPackageRev CacheDir
cachedir 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) -> Maybe Text
forall a. Maybe a
Nothing
            (Word, Word, Word)
_ -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ PkgRevInfo PkgM -> Text
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' SemVer -> SemVer -> Bool
forall a. Eq a => a -> a -> Bool
== SemVer
v ->
              IO () -> PkgM ()
forall a. IO a -> PkgM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PkgM ()) -> IO () -> PkgM ()
forall a b. (a -> b) -> a -> b
$ Text -> IO ()
T.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Package already at version " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SemVer -> Text
prettySemVer SemVer
v Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"; nothing to do."
          | Bool
otherwise ->
              IO () -> PkgM ()
forall a. IO a -> PkgM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PkgM ()) -> IO () -> PkgM ()
forall a b. (a -> b) -> a -> b
$
                Text -> IO ()
T.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$
                  Text
"Replaced "
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
p
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" "
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SemVer -> Text
prettySemVer (Required -> SemVer
requiredPkgRev Required
prev_r')
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" => "
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SemVer -> Text
prettySemVer SemVer
v
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
        Maybe Required
Nothing ->
          IO () -> PkgM ()
forall a. IO a -> PkgM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PkgM ()) -> IO () -> PkgM ()
forall a b. (a -> b) -> a -> b
$ Text -> IO ()
T.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Added new required package " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
p Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SemVer -> Text
prettySemVer SemVer
v Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
      PkgManifest -> PkgM ()
putPkgManifest PkgManifest
m'
      IO () -> PkgM ()
forall a. IO a -> PkgM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PkgM ()) -> IO () -> PkgM ()
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" (([String] -> PkgConfig -> Maybe (IO ()))
 -> String -> [String] -> IO ())
-> ([String] -> PkgConfig -> Maybe (IO ()))
-> String
-> [String]
-> IO ()
forall a b. (a -> b) -> a -> b
$ \[String]
args PkgConfig
cfg ->
  case [String]
args of
    [String
p] -> IO () -> Maybe (IO ())
forall a. a -> Maybe a
Just (IO () -> Maybe (IO ())) -> IO () -> Maybe (IO ())
forall a b. (a -> b) -> a -> b
$ PkgConfig -> PkgM () -> IO ()
forall a. PkgConfig -> PkgM a -> IO a
runPkgM PkgConfig
cfg (PkgM () -> IO ()) -> PkgM () -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> PkgM ()
doRemove' (Text -> PkgM ()) -> Text -> PkgM ()
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
p
    [String]
_ -> Maybe (IO ())
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 -> IO () -> PkgM ()
forall a. IO a -> PkgM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PkgM ()) -> IO () -> PkgM ()
forall a b. (a -> b) -> a -> b
$ do
          Text -> IO ()
T.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"No package " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
p Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" found in " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
futharkPkg Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
          IO ()
forall a. IO a
exitFailure
        Just (PkgManifest
m', Required
r) -> do
          PkgManifest -> PkgM ()
putPkgManifest PkgManifest
m'
          IO () -> PkgM ()
forall a. IO a -> PkgM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PkgM ()) -> IO () -> PkgM ()
forall a b. (a -> b) -> a -> b
$ Text -> IO ()
T.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Removed " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
p Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SemVer -> Text
prettySemVer (Required -> SemVer
requiredPkgRev Required
r) Text -> Text -> Text
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" (([String] -> PkgConfig -> Maybe (IO ()))
 -> String -> [String] -> IO ())
-> ([String] -> PkgConfig -> Maybe (IO ()))
-> String
-> [String]
-> IO ()
forall a b. (a -> b) -> a -> b
$ \[String]
args PkgConfig
cfg ->
  case [String]
args of
    [String
p] -> IO () -> Maybe (IO ())
forall a. a -> Maybe a
Just (IO () -> Maybe (IO ())) -> IO () -> Maybe (IO ())
forall a b. (a -> b) -> a -> b
$ PkgConfig -> PkgM () -> IO ()
forall a. PkgConfig -> PkgM a -> IO a
runPkgM PkgConfig
cfg (PkgM () -> IO ()) -> PkgM () -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> PkgM ()
doCreate' (Text -> PkgM ()) -> Text -> PkgM ()
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
p
    [String]
_ -> Maybe (IO ())
forall a. Maybe a
Nothing
  where
    validPkgPath :: Text -> Bool
validPkgPath Text
p =
      Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
".", String
".."]) ([String] -> Bool) -> [String] -> Bool
forall a b. (a -> b) -> a -> b
$ String -> [String]
splitDirectories (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
p

    doCreate' :: Text -> PkgM ()
doCreate' Text
p = do
      Bool -> PkgM () -> PkgM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text -> Bool
validPkgPath Text
p) (PkgM () -> PkgM ()) -> (IO () -> PkgM ()) -> IO () -> PkgM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> PkgM ()
forall a. IO a -> PkgM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PkgM ()) -> IO () -> PkgM ()
forall a b. (a -> b) -> a -> b
$ do
        Text -> IO ()
T.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Not a valid package path: " Text -> Text -> Text
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."
        IO ()
forall a. IO a
exitFailure

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

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

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

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

      Required -> m Required
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        Required
req
          { requiredPkgRev :: SemVer
requiredPkgRev = SemVer
v,
            requiredHash :: Maybe Text
requiredHash = Text -> Maybe Text
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" (([String] -> PkgConfig -> Maybe (IO ()))
 -> String -> [String] -> IO ())
-> ([String] -> PkgConfig -> Maybe (IO ()))
-> String
-> [String]
-> IO ()
forall a b. (a -> b) -> a -> b
$ \[String]
args PkgConfig
cfg ->
  case [String]
args of
    [String
p] -> IO () -> Maybe (IO ())
forall a. a -> Maybe a
Just (IO () -> Maybe (IO ())) -> IO () -> Maybe (IO ())
forall a b. (a -> b) -> a -> b
$ (CacheDir -> IO ()) -> IO ()
forall a. (CacheDir -> IO a) -> IO a
withCacheDir ((CacheDir -> IO ()) -> IO ()) -> (CacheDir -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CacheDir
cachedir ->
      PkgConfig -> PkgM () -> IO ()
forall a. PkgConfig -> PkgM a -> IO a
runPkgM PkgConfig
cfg (PkgM () -> IO ()) -> PkgM () -> IO ()
forall a b. (a -> b) -> a -> b
$ CacheDir -> Text -> PkgM ()
forall {m :: * -> *}.
MonadPkgRegistry m =>
CacheDir -> Text -> m ()
doVersions' CacheDir
cachedir (Text -> PkgM ()) -> Text -> PkgM ()
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
p
    [String]
_ -> Maybe (IO ())
forall a. Maybe a
Nothing
  where
    doVersions' :: CacheDir -> Text -> m ()
doVersions' CacheDir
cachedir =
      (SemVer -> m ()) -> [SemVer] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (SemVer -> IO ()) -> SemVer -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> IO ()
T.putStrLn (Text -> IO ()) -> (SemVer -> Text) -> SemVer -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SemVer -> Text
prettySemVer) ([SemVer] -> m ()) -> (PkgInfo m -> [SemVer]) -> PkgInfo m -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map SemVer (PkgRevInfo m) -> [SemVer]
forall k a. Map k a -> [k]
M.keys (Map SemVer (PkgRevInfo m) -> [SemVer])
-> (PkgInfo m -> Map SemVer (PkgRevInfo m))
-> PkgInfo m
-> [SemVer]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PkgInfo m -> Map SemVer (PkgRevInfo m)
forall (m :: * -> *). PkgInfo m -> Map SemVer (PkgRevInfo m)
pkgVersions
        (PkgInfo m -> m ()) -> (Text -> m (PkgInfo m)) -> Text -> m ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< CacheDir -> Text -> m (PkgInfo m)
forall (m :: * -> *).
MonadPkgRegistry m =>
CacheDir -> Text -> m (PkgInfo m)
lookupPackage CacheDir
cachedir

-- | 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.
  IO () -> IO ()
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
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... <" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"|" (((String, (String -> [String] -> IO (), Text)) -> String)
-> [(String, (String -> [String] -> IO (), Text))] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, (String -> [String] -> IO (), Text)) -> String
forall a b. (a, b) -> a
fst [(String, (String -> [String] -> IO (), Text))]
commands) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
">"
  case [String]
args of
    String
cmd : [String]
args'
      | Just (String -> [String] -> IO ()
m, Text
_) <- String
-> [(String, (String -> [String] -> IO (), Text))]
-> Maybe (String -> [String] -> IO (), 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
_ () = IO b -> Maybe (IO b)
forall a. a -> Maybe a
Just (IO b -> Maybe (IO b)) -> IO b -> Maybe (IO b)
forall a b. (a -> b) -> a -> b
$ do
            let k :: Int
k = [Int] -> Int
forall a (f :: * -> *). (Num a, Ord a, Foldable f) => f a -> a
maxinum (((String, (String -> [String] -> IO (), Text)) -> Int)
-> [(String, (String -> [String] -> IO (), Text))] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int)
-> ((String, (String -> [String] -> IO (), Text)) -> String)
-> (String, (String -> [String] -> IO (), Text))
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, (String -> [String] -> IO (), Text)) -> String
forall a b. (a, b) -> a
fst) [(String, (String -> [String] -> IO (), Text))]
commands) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3
            Text -> IO b
forall {b}. Text -> IO b
usageMsg (Text -> IO b) -> ([Text] -> Text) -> [Text] -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.unlines ([Text] -> IO b) -> [Text] -> IO b
forall a b. (a -> b) -> a -> b
$
              [Text
"<command> ...:", Text
"", Text
"Commands:"]
                [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [ Text
"   " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
cmd Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
cmd) Char
' ') Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
desc
                     | (String
cmd, (String -> [String] -> IO ()
_, Text
desc)) <- [(String, (String -> [String] -> IO (), Text))]
commands
                   ]

      ()
-> [FunOptDescr ()]
-> String
-> ([String] -> () -> Maybe (IO ()))
-> String
-> [String]
-> IO ()
forall cfg.
cfg
-> [FunOptDescr cfg]
-> String
-> ([String] -> cfg -> Maybe (IO ()))
-> String
-> [String]
-> IO ()
mainWithOptions () [] String
usage [String] -> () -> Maybe (IO ())
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 (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Usage: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
prog Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" [--version] [--help] " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s
      IO b
forall a. IO a
exitFailure