Skip to content
Snippets Groups Projects
Select Git revision
  • 668daf92d3b1c32aaf2c64a8f8e162c485bd5efc
  • main default protected
  • 75389691-a67c-422a-91e9-aa58bfb5-main-patch-32205
  • test-pipe
  • extended-scripts
  • structured-badges
  • guix-pipeline
  • cabal-pipeline
8 results

WriteRepo.hs

Blame
  • WriteRepo.hs 2.61 KiB
    {-# LANGUAGE LambdaCase          #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    
    
    -- | Module for writing an already linted map Repository back out again.
    module WriteRepo where
    
    import           CheckDir               (DirResult (..), resultIsFatal)
    import           CheckMap               (MapResult (..))
    import           Control.Monad          (forM_, unless)
    import           Control.Monad.Extra    (ifM)
    import           Data.Aeson             (encodeFile)
    import           Data.Map.Strict        (toList)
    import           Data.Maybe             (mapMaybe)
    import           Data.Set               (Set)
    import qualified Data.Set               as S
    import           LintConfig             (LintConfig (configDontCopyAssets),
                                             LintConfig')
    import           Paths                  (normalise)
    import           System.Directory.Extra (copyFile, createDirectoryIfMissing,
                                             doesDirectoryExist)
    import           System.Exit            (ExitCode (..))
    import           System.FilePath        (takeDirectory)
    import qualified System.FilePath        as FP
    import           System.FilePath.Posix  ((</>))
    import           Types                  (Dep (Local))
    
    
    
    writeAdjustedRepository :: LintConfig' -> FilePath -> FilePath -> DirResult -> IO ExitCode
    writeAdjustedRepository config inPath outPath result
      | resultIsFatal config result =
          pure (ExitFailure 1)
      | otherwise = do
          ifM (doesDirectoryExist outPath) (pure (ExitFailure 2)) $ do
            createDirectoryIfMissing True outPath
    
            -- write out all maps
            mapM_
              (\(path,out) -> encodeFile (outPath </> path) $ mapresultAdjusted out)
              (toList $ dirresultMaps result)
    
            unless (configDontCopyAssets config) $ do
              -- collect asset dependencies of maps
              -- TODO: its kinda weird doing that here, tbh
              let localdeps :: Set FilePath =
                    S.fromList . concatMap
                      (\(mappath,mapresult) ->
                         let mapdir = takeDirectory mappath in
                         mapMaybe (\case
                           Local path -> Just . normalise mapdir $ path
                           _          -> Nothing)
                         $ mapresultDepends mapresult)
                    . toList $ dirresultMaps result
    
              -- copy all assets
              forM_ localdeps $ \path ->
                let
                  assetPath = FP.normalise $ inPath </> path
                  newPath = FP.normalise $ outPath </> path
                in do
                  createDirectoryIfMissing True (takeDirectory newPath)
                  copyFile assetPath newPath
    
            pure ExitSuccess