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
installInDir :: CacheDir -> BuildList -> FilePath -> PkgM ()
installInDir :: CacheDir -> BuildList -> String -> PkgM ()
installInDir CacheDir
cachedir (BuildList Map Text SemVer
bl) String
dir =
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 =>
CacheDir -> Text -> SemVer -> m (PkgRevInfo m)
lookupPackageRev CacheDir
cachedir Text
p SemVer
v
(String
filedir, [String]
files) <- forall (m :: * -> *). GetFiles m -> m (String, [String])
getFiles forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). PkgRevInfo m -> GetFiles m
pkgGetFiles PkgRevInfo PkgM
info
let pdir :: String
pdir = String
dir 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
$ String -> IO ()
removePathForcibly String
pdir
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [String]
files 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
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 -> String
takeDirectory String
to
forall (m :: * -> *) a. (MonadLogger m, ToLog a) => a -> m ()
logMsg forall a b. (a -> b) -> a -> b
$ String
"Copying " forall a. Semigroup a => a -> a -> a
<> String
from forall a. Semigroup a => a -> a -> a
<> String
"\n" forall a. Semigroup a => a -> a -> a
<> String
"to " forall a. Semigroup a => a -> a -> a
<> String
to
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO 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")
installBuildList :: CacheDir -> Maybe PkgPath -> BuildList -> PkgM ()
installBuildList :: CacheDir -> Maybe Text -> BuildList -> PkgM ()
installBuildList CacheDir
cachedir 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
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
CacheDir -> BuildList -> String -> PkgM ()
installInDir CacheDir
cachedir BuildList
bl String
libNewDir
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
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
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
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 ()
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
newtype PkgConfig = PkgConfig {PkgConfig -> Bool
pkgVerbose :: Bool}
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
withCacheDir :: (CacheDir -> IO a) -> IO a
withCacheDir :: forall a. (CacheDir -> IO a) -> IO a
withCacheDir CacheDir -> IO a
f = forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
String -> (String -> m a) -> m a
withSystemTempDirectory String
"futhark-pkg" forall a b. (a -> b) -> a -> b
$ CacheDir -> IO a
f 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" forall a b. (a -> b) -> a -> b
$ \[String]
args PkgConfig
cfg ->
case [String]
args of
[] -> forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (CacheDir -> IO a) -> IO a
withCacheDir forall a b. (a -> b) -> a -> b
$ \CacheDir
cachedir -> 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 =>
CacheDir -> PkgRevDeps -> m BuildList
solveDeps CacheDir
cachedir 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 b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (CacheDir -> IO a) -> IO a
withCacheDir forall a b. (a -> b) -> a -> b
$ \CacheDir
cachedir -> 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 =>
CacheDir -> PkgRevDeps -> m BuildList
solveDeps CacheDir
cachedir forall a b. (a -> b) -> a -> b
$ PkgManifest -> PkgRevDeps
pkgRevDeps PkgManifest
m
CacheDir -> Maybe Text -> BuildList -> PkgM ()
installBuildList CacheDir
cachedir (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. (CacheDir -> IO a) -> IO a
withCacheDir forall a b. (a -> b) -> a -> b
$ \CacheDir
cachedir ->
forall a. PkgConfig -> PkgM a -> IO a
runPkgM PkgConfig
cfg forall a b. (a -> b) -> a -> b
$ CacheDir -> Text -> SemVer -> PkgM ()
doAdd' CacheDir
cachedir (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. (CacheDir -> IO a) -> IO a
withCacheDir forall a b. (a -> b) -> a -> b
$ \CacheDir
cachedir ->
forall a. PkgConfig -> PkgM a -> IO a
runPkgM PkgConfig
cfg forall a b. (a -> b) -> a -> b
$
CacheDir -> Text -> SemVer -> PkgM ()
doAdd' CacheDir
cachedir (String -> Text
T.pack String
p) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *).
MonadPkgRegistry m =>
CacheDir -> Text -> m SemVer
lookupNewestRev CacheDir
cachedir (String -> Text
T.pack String
p)
[String]
_ -> forall a. Maybe a
Nothing
where
doAdd' :: CacheDir -> Text -> SemVer -> PkgM ()
doAdd' CacheDir
cachedir Text
p SemVer
v = do
PkgManifest
m <- PkgM PkgManifest
getPkgManifest
BuildList
_ <- forall (m :: * -> *).
MonadPkgRegistry m =>
CacheDir -> PkgRevDeps -> m BuildList
solveDeps CacheDir
cachedir 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
PkgRevInfo PkgM
p_info <- 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
(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 b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (CacheDir -> IO a) -> IO a
withCacheDir forall a b. (a -> b) -> a -> b
$ \CacheDir
cachedir -> 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 =>
CacheDir -> Required -> m Required
upgrade CacheDir
cachedir))) 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 :: CacheDir -> Required -> m Required
upgrade CacheDir
cachedir Required
req = do
SemVer
v <- forall (m :: * -> *).
MonadPkgRegistry m =>
CacheDir -> Text -> m SemVer
lookupNewestRev CacheDir
cachedir 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 =>
CacheDir -> Text -> SemVer -> m (PkgRevInfo m)
lookupPackageRev CacheDir
cachedir (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. (CacheDir -> IO a) -> IO a
withCacheDir forall a b. (a -> b) -> a -> b
$ \CacheDir
cachedir ->
forall a. PkgConfig -> PkgM a -> IO a
runPkgM PkgConfig
cfg forall a b. (a -> b) -> a -> b
$ forall {m :: * -> *}.
MonadPkgRegistry m =>
CacheDir -> Text -> m ()
doVersions' CacheDir
cachedir forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
p
[String]
_ -> forall a. Maybe a
Nothing
where
doVersions' :: CacheDir -> Text -> m ()
doVersions' CacheDir
cachedir =
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 =>
CacheDir -> Text -> m (PkgInfo m)
lookupPackage CacheDir
cachedir
main :: String -> [String] -> IO ()
main :: String -> [String] -> IO ()
main String
prog [String]
args = do
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 b c a. (b -> c) -> (a -> b) -> a -> c
. [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