
   0 | module Pack.Core.IO
   1 | 
   2 | import public Control.Monad.Either
   3 | import Pack.Config.Environment.Variable
   4 | import Pack.Config.Types
   5 | import Pack.Core.Logging
   6 | import Pack.Core.Types
   7 | import System
   8 | import System.Directory
   9 | import System.File
  10 | 
  11 | %default total
  12 | 
  13 | --------------------------------------------------------------------------------
  14 | --          Utilities
  15 | --------------------------------------------------------------------------------
  16 | 
  17 | export
  18 | mapMaybeM : Monad m => (a -> m (Maybe b)) -> List a -> m (List b)
  19 | mapMaybeM f []        = pure []
  20 | mapMaybeM f (x :: xs) = do
  21 |   Just vb <- f x | Nothing => mapMaybeM f xs
  22 |   (vb ::) <$> mapMaybeM f xs
  23 | 
  24 | export
  25 | filterM : Monad m => (a -> m Bool) -> List a -> m (List a)
  26 | filterM f []        = pure []
  27 | filterM f (x :: xs) = do
  28 |   True <- f x | False => filterM f xs
  29 |   (x ::) <$> filterM f xs
  30 | 
  31 | export
  32 | ignoreError : Monad m => EitherT err m () -> m ()
  33 | ignoreError = ignore . runEitherT
  34 | 
  35 | ||| Convert an IO action with the potential of failure
  36 | ||| to an `EitherT PackErr`.
  37 | export
  38 | eitherIO :
  39 |      {auto _ : HasIO io}
  40 |   -> (toErr : err -> PackErr)
  41 |   -> (act : io (Either err a))
  42 |   -> EitherT PackErr io a
  43 | eitherIO toErr = MkEitherT . map (mapFst toErr)
  44 | 
  45 | ||| Make sure a *cleanup* action is run after
  46 | ||| an IO action that might fail.
  47 | export
  48 | finally :
  49 |      {auto _ : Monad m}
  50 |   -> (cleanup : EitherT err m ())
  51 |   -> (act     : EitherT err m a)
  52 |   -> EitherT err m a
  53 | finally cleanup act = MkEitherT $ do
  54 |   res <- runEitherT act
  55 |   ignoreError cleanup
  56 |   pure res
  57 | 
  58 | ||| Runs a *pack* program, printing errors to standard out.
  59 | export
  60 | run : EitherT PackErr IO () -> IO ()
  61 | run (MkEitherT io) = io >>= either fatal pure
  62 | 
  63 | --------------------------------------------------------------------------------
  64 | --          System Commands
  65 | --------------------------------------------------------------------------------
  66 | 
  67 | ||| Display a list of variable-value pairs in the format
  68 | ||| `VAR1="val1" VAR2="val2"`.
  69 | export
  70 | dispEnv : List EnvVar -> String
  71 | dispEnv = unwords . map interpolate
  72 | 
  73 | ||| Tries to run a system command.
  74 | export
  75 | sys : HasIO io => (cmd : CmdArgList) -> EitherT PackErr io ()
  76 | sys cmd = do
  77 |   0 <- system $ escapeCmd cmd | n => throwE (Sys cmd n)
  78 |   pure ()
  79 | 
  80 | logCmdOutput :
  81 |      {auto _   : HasIO io}
  82 |   -> {auto ref : LogRef}
  83 |   -> (lvl : LogLevel)
  84 |   -> (msg : String)
  85 |   -> io ()
  86 | logCmdOutput lvl msg =
  87 |   when (msg /= "") $ log ref lvl msg
  88 | 
  89 | lineBufferedCmd : Env => CmdArgList -> CmdArgList
  90 | lineBufferedCmd args = lineBufferingCmd %search ++ args
  91 | 
  92 | ||| Tries to run a system command while logging its output.
  93 | export covering
  94 | sysAndLog :
  95 |      {auto _ : HasIO io}
  96 |   -> {auto _ : Env}
  97 |   -> (lvl : LogLevel)
  98 |   -> (cmd : CmdArgList)
  99 |   -> EitherT PackErr io ()
 100 | sysAndLog lvl cmd = do
 101 |   0 <- runProcessingOutput
 102 |          (logCmdOutput lvl)
 103 |          (escapeCmd $ lineBufferedCmd cmd)
 104 |     | n => throwE (Sys cmd n)
 105 |   pure ()
 106 | 
 107 | cmdWithEnv : CmdArgList -> List EnvVar -> String
 108 | cmdWithEnv cmd []  = escapeCmd cmd
 109 | cmdWithEnv cmd env = "\{dispEnv env} \{escapeCmd cmd}"
 110 | 
 111 | ||| Tries to run a system command prefixed with the given
 112 | ||| environment variables.
 113 | |||
 114 | ||| Note: In case of an error, the environment will not be part
 115 | ||| of the command listed in the error message. This is a
 116 | ||| deliberate choice to declutter Idris output in case of a
 117 | ||| failed build. If the environment should be included in the
 118 | ||| error message, just prefix `cmd` accordingly and use `sys`.
 119 | export
 120 | sysWithEnv :
 121 |      {auto _ : HasIO io}
 122 |   -> (cmd : CmdArgList)
 123 |   -> (env : List EnvVar)
 124 |   -> EitherT PackErr io ()
 125 | sysWithEnv cmd env = do
 126 |   0 <- system (cmdWithEnv cmd env) | n => throwE (Sys cmd n)
 127 |   pure ()
 128 | 
 129 | export covering
 130 | sysWithEnvAndLog :
 131 |      {auto _ : HasIO io}
 132 |   -> {auto _ : Env}
 133 |   -> (lvl : LogLevel)
 134 |   -> (cmd : CmdArgList)
 135 |   -> (env : List EnvVar)
 136 |   -> EitherT PackErr io ()
 137 | sysWithEnvAndLog lvl cmd env = do
 138 |   0 <- runProcessingOutput
 139 |          (logCmdOutput lvl)
 140 |          (cmdWithEnv (lineBufferedCmd cmd) env)
 141 |     | n => throwE (Sys cmd n)
 142 |   pure ()
 143 | 
 144 | ||| Tries to run a system command returning its output.
 145 | export covering
 146 | sysRun : HasIO io => (cmd : CmdArgList) -> EitherT PackErr io String
 147 | sysRun cmd = do
 148 |   (res,0) <- run (escapeCmd cmd) | (_,n) => throwE (Sys cmd n)
 149 |   pure res
 150 | 
 151 | ||| Tries to run a system command prefixed with the given
 152 | ||| environment variables returning its output.
 153 | |||
 154 | ||| Note: In case of an error, the environment will not be part
 155 | ||| of the command listed in the error message. This is a
 156 | ||| deliberate choice to declutter Idris output in case of a
 157 | ||| failed build. If the environment should be included in the
 158 | ||| error message, just prefix `cmd` accordingly and use `sys`.
 159 | export covering
 160 | sysRunWithEnv :
 161 |      {auto _ : HasIO io}
 162 |   -> (cmd : CmdArgList)
 163 |   -> (env : List EnvVar)
 164 |   -> EitherT PackErr io String
 165 | sysRunWithEnv cmd env = do
 166 |   (res,0) <- System.run (cmdWithEnv cmd env) | (_,n) => throwE (Sys cmd n)
 167 |   pure res
 168 | 
 169 | --------------------------------------------------------------------------------
 170 | --         Working with Directories
 171 | --------------------------------------------------------------------------------
 172 | 
 173 | ||| Checks if a file at the given location exists.
 174 | export %inline
 175 | exists : HasIO io => (dir : Path Abs) -> io Bool
 176 | exists = exists . interpolate
 177 | 
 178 | ||| Checks if a file at the given location exists.
 179 | export %inline
 180 | fileExists : HasIO io => (f : File Abs) -> io Bool
 181 | fileExists = exists . interpolate
 182 | 
 183 | ||| Checks if a file at the given location is missing.
 184 | export
 185 | missing : HasIO io => (dir : Path Abs) -> io Bool
 186 | missing = map not . exists
 187 | 
 188 | ||| Checks if a file at the given location is missing.
 189 | export
 190 | fileMissing : HasIO io => (f : File Abs) -> io Bool
 191 | fileMissing = map not . fileExists
 192 | 
 193 | ||| Tries to create a director (including parent directories)
 194 | export
 195 | mkDir : HasIO io => (dir : Path Abs) -> EitherT PackErr io ()
 196 | mkDir (PAbs _ [<]) = pure ()
 197 | mkDir d            = sys ["mkdir", "-p", d]
 198 | 
 199 | ||| Creates a parent directory of a (file) path
 200 | export
 201 | mkParentDir : HasIO io => (p : Path Abs) -> EitherT PackErr io ()
 202 | mkParentDir p = whenJust (parentDir p) mkDir
 203 | 
 204 | ||| Forcefully deletes a directory with all its content
 205 | export
 206 | rmDir : HasIO io => (dir : Path Abs) -> EitherT PackErr io ()
 207 | rmDir dir = when !(exists dir) $ sys ["rm", "-rf", dir]
 208 | 
 209 | ||| Returns the current directory's path.
 210 | export
 211 | curDir : HasIO io => EitherT PackErr io (Path Abs)
 212 | curDir = do
 213 |   Just s <- currentDir | Nothing => throwE NoCurDir
 214 |   case the FilePath (fromString s) of
 215 |     FP (PAbs u sx) => pure (PAbs u sx)
 216 |     FP (PRel _)    => throwE NoCurDir
 217 | 
 218 | ||| Changes the working directory
 219 | export
 220 | chgDir : HasIO io => (dir : Path Abs) -> EitherT PackErr io ()
 221 | chgDir dir = do
 222 |   True <- changeDir "\{dir}" | False => throwE (ChangeDir dir)
 223 |   pure ()
 224 | 
 225 | ||| Runs an action in the given directory, changing back
 226 | ||| to the current directory afterwards.
 227 | export
 228 | inDir :
 229 |      {auto _ : HasIO io}
 230 |   -> (dir : Path Abs)
 231 |   -> (act : Path Abs -> EitherT PackErr io a)
 232 |   -> EitherT PackErr io a
 233 | inDir dir act =
 234 |   curDir >>= \cur => finally (chgDir cur) (chgDir dir >> act dir)
 235 | 
 236 | ||| Returns the names of entries in a directory
 237 | export
 238 | entries :
 239 |      {auto _ : HasIO io}
 240 |   -> (dir : Path Abs)
 241 |   -> EitherT PackErr io (List Body)
 242 | entries dir = do
 243 |   ss <- eitherIO (DirEntries dir) (listDir "\{dir}")
 244 |   pure (mapMaybe parse ss)
 245 | 
 246 | ||| Returns the names of toml files in a directory
 247 | export
 248 | tomlFiles :  {auto _ : HasIO io}
 249 |   -> (dir : Path Abs)
 250 |   -> EitherT PackErr io (List Body)
 251 | tomlFiles dir = filter isTomlBody <$> entries dir
 252 | 
 253 | ||| Returns the names of toml files in a directory
 254 | export
 255 | htmlFiles :  {auto _ : HasIO io}
 256 |   -> (dir : Path Abs)
 257 |   -> EitherT PackErr io (List Body)
 258 | htmlFiles dir = filter isHtmlBody <$> entries dir
 259 | 
 260 | ||| Returns the names of entries in the current directory
 261 | export
 262 | currentEntries : HasIO io => EitherT PackErr io (List Body)
 263 | currentEntries = curDir >>= entries
 264 | 
 265 | ||| Copy a directory.
 266 | export
 267 | copyDir : HasIO io => (from,to : Path Abs) -> EitherT PackErr io ()
 268 | copyDir from to = do
 269 |   mkParentDir to
 270 |   sys ["cp", "-r", from, to]
 271 | 
 272 | ||| Copy a whole directory into the given parent directory.
 273 | export
 274 | copyDirInto : HasIO io => (from,parent : Path Abs) -> EitherT PackErr io ()
 275 | copyDirInto from parent = do
 276 |   mkDir parent
 277 |   sys ["cp", "-r", from, "\{parent}/"]
 278 | 
 279 | ||| Tries to find the first file, the body of which returns `True` for
 280 | ||| the given predicate.
 281 | export
 282 | findInParentDirs :  {auto _ : HasIO io}
 283 |   -> (Body -> Bool)
 284 |   -> Path Abs
 285 |   -> EitherT PackErr io (Maybe (File Abs))
 286 | findInParentDirs p (PAbs d sb) = go sb
 287 |   where go : SnocList Body -> EitherT PackErr io (Maybe (File Abs))
 288 |         go [<]       = pure Nothing
 289 |         go (sb :< b) =
 290 |           let dir := PAbs d (sb :< b)
 291 |            in do
 292 |              (h :: _) <- filter p <$> entries dir | Nil => go sb
 293 |              pure $ Just (MkF dir h)
 294 | 
 295 | ||| Tries to find the first file, the body of which return `True` for
 296 | ||| the given predicate, in each parent directory.
 297 | export
 298 | findInAllParentDirs :  {auto _ : HasIO io}
 299 |   -> (Body -> Bool)
 300 |   -> Path Abs
 301 |   -> EitherT PackErr io $ List $ File Abs
 302 | findInAllParentDirs p = go [] where
 303 |   go : List (File Abs) -> Path Abs -> EitherT PackErr io $ List $ File Abs
 304 |   go presentRes currD = do
 305 |     Just af <- findInParentDirs p currD
 306 |       | Nothing => pure presentRes
 307 |     let nextRes = af::presentRes
 308 |     case parentDir $ parent af of
 309 |       Just parentD => go nextRes $ assert_smaller currD parentD
 310 |       Nothing      => pure nextRes
 311 | 
 312 | mkTmpDir : HasIO io => (pd : PackDirs) => EitherT PackErr io TmpDir
 313 | mkTmpDir = go 100 0
 314 | 
 315 |   where
 316 |     go : Nat -> Nat -> EitherT PackErr io TmpDir
 317 |     go 0     _ = throwE NoTmpDir
 318 |     go (S k) n =
 319 |       let Just body := Body.parse ".tmp\{show n}" | Nothing => go k (S n)
 320 |           dir       := pd.cache /> body
 321 |        in do
 322 |          False <- exists dir | True => go k (S n)
 323 |          when (n > 50) $
 324 |            warn {ref = MkLogRef Info}
 325 |              """
 326 |              Too many temporary directories. Please remove all `.tmpXY`
 327 |              directories in `\{pd.cache}` or run `pack gc` to let pack
 328 |              clean them up.
 329 |              """
 330 |          mkDir dir
 331 |          pure (TD dir)
 332 | 
 333 | export
 334 | withTmpDir :
 335 |      {auto _ : HasIO io}
 336 |   -> {auto _ : PackDirs}
 337 |   -> (TmpDir => EitherT PackErr io a)
 338 |   -> EitherT PackErr io a
 339 | withTmpDir f = do
 340 |   td <- mkTmpDir
 341 |   finally (rmDir tmpDir) f
 342 | 
 343 |   --------------------------------------------------------------------------------
 344 |   --         File Access
 345 |   --------------------------------------------------------------------------------
 346 | 
 347 | ||| Delete a file.
 348 | export
 349 | rmFile : HasIO io => (f : File Abs) -> EitherT PackErr io ()
 350 | rmFile f = when !(fileExists f) $ sys ["rm", f]
 351 | 
 352 | ||| Tries to read the content of a file
 353 | export covering
 354 | read : HasIO io => File Abs -> EitherT PackErr io String
 355 | read fn = eitherIO (ReadFile fn) (readFile "\{fn}")
 356 | 
 357 | ||| Reads the content of a file if it exists, otherwise
 358 | ||| returns the given alternative string.
 359 | export covering
 360 | readIfExists :  {auto _ : HasIO io}
 361 |   -> (file : File Abs)
 362 |   -> (alt  : String)
 363 |   -> EitherT PackErr io String
 364 | readIfExists file alt = do
 365 |   True <- fileExists file | False => pure alt
 366 |   read file
 367 | 
 368 | ||| Tries to write a string to a file.
 369 | ||| The file's parent directory is created if
 370 | ||| it does not yet exist.
 371 | export covering
 372 | write : HasIO io => File Abs -> String -> EitherT PackErr io ()
 373 | write file str = do
 374 |   mkDir file.parent
 375 |   eitherIO (WriteFile file) (writeFile "\{file}" str)
 376 | 
 377 | ||| Creates a symbolic link from one path to another,
 378 | ||| remove a link at path `to` if there already is one.
 379 | export
 380 | link : HasIO io => (from : Path Abs) -> (to : File Abs) -> EitherT PackErr io ()
 381 | link from to = do
 382 |   rmFile to
 383 |   mkDir to.parent
 384 |   sys ["ln", "-s", from, to]
 385 | 
 386 | ||| Copy a file.
 387 | export
 388 | copyFile : HasIO io => (from,to : File Abs) -> EitherT PackErr io ()
 389 | copyFile from to = do
 390 |   mkDir to.parent
 391 |   sys ["cp", from, to]
 392 | 
 393 | ||| Patch a file
 394 | export
 395 | patch :  {auto _ : HasIO io}
 396 |   -> (original : File Abs)
 397 |   -> (patch    : File Abs)
 398 |   -> EitherT PackErr io ()
 399 | patch o p = sys ["patch", o, p]
 400 |