Skip to content
Snippets Groups Projects
Select Git revision
1 result Searching

test_csrf.py

Blame
  • Forked from uffd / uffd
    Source project has a limited visibility.
    WriteRepo.hs 2.68 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
            forM_ (toList $ dirresultMaps result) $ \(path,out) -> do
              createDirectoryIfMissing True (takeDirectory (outPath </> path))
              encodeFile (outPath </> path) $ mapresultAdjusted out
    
            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