copy map assets (and refuse if any are missing)

2 files changed, 56 insertions, 22 deletions

diff --git a/lib/CheckDir.hs b/lib/CheckDir.hs
index 68bcefe..5540aae 100644
--- a/lib/CheckDir.hs
+++ b/lib/CheckDir.hs
@@ -6,7 +6,7 @@
 {-# LANGUAGE TupleSections     #-}
 
 -- | Module that contains high-level checking for an entire directory
-module CheckDir (recursiveCheckDir, DirResult(..))  where
+module CheckDir (recursiveCheckDir, DirResult(..), resultIsFatal)  where
 
 import           CheckMap               (MapResult (mapresultProvides),
                                          loadAndLintMap, mapresultDepends)
@@ -47,7 +47,7 @@ data DirResult = DirResult
   , dirresultDeps          :: [MissingDep]
   -- ^ all dependencies to things outside this repository
   , dirresultMissingAssets :: [MissingAsset]
-  -- ^ local things that are referred to but missing
+  -- ^ entrypoints of maps which are referred to but missing
   } deriving (Generic)
 
 data MissingDep = MissingDep
@@ -57,6 +57,13 @@ data MissingDep = MissingDep
 
 newtype MissingAsset = MissingAsset MissingDep
 
+
+resultIsFatal :: DirResult -> Bool
+resultIsFatal res =
+  not $ null (dirresultMissingAssets res)
+
+
+
 instance ToJSON DirResult where
   toJSON res = A.object
     [ "missingDeps" .= dirresultDeps res
diff --git a/lib/WriteRepo.hs b/lib/WriteRepo.hs
index 5e695f5..c0bf31b 100644
--- a/lib/WriteRepo.hs
+++ b/lib/WriteRepo.hs
@@ -1,28 +1,55 @@
-
+{-# LANGUAGE LambdaCase          #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 
 
 -- | Module for writing an already linted map Repository back out again.
-
 module WriteRepo where
 
-import           CheckDir               (DirResult (dirresultMaps))
-import           CheckMap               (MapResult (mapresultAdjusted))
+import           CheckDir               (DirResult (dirresultMaps),
+                                         resultIsFatal)
+import           CheckMap               (MapResult (mapresultAdjusted, mapresultDepends))
+import           Control.Monad          (forM_)
 import           Data.Aeson             (encodeFile)
 import           Data.Map.Strict        (toList)
-import           System.Directory.Extra (createDirectoryIfMissing)
+import           Data.Maybe             (mapMaybe)
+import           Data.Set               (Set)
+import qualified Data.Set               as S
+import           Paths                  (normalise)
+import           System.Directory.Extra (copyFile, createDirectoryIfMissing)
+import           System.FilePath        (takeDirectory)
+import qualified System.FilePath        as FP
 import           System.FilePath.Posix  ((</>))
-
-
-
-writeAdjustedRepository :: FilePath -> DirResult -> IO ()
-writeAdjustedRepository outPath result = do
-
-  -- True here just means the equivalent of mkdir -p
-  createDirectoryIfMissing True outPath
-
-  -- write out all maps
-  mapM_
-    (\(path,out) -> encodeFile (outPath </> path) $ mapresultAdjusted out)
-    (toList $ dirresultMaps result)
-
-  -- TODO: copy all assets
+import           Types                  (Dep (Local))
+
+
+writeAdjustedRepository :: FilePath -> FilePath -> DirResult -> IO ()
+writeAdjustedRepository inPath outPath result
+  | resultIsFatal result = pure ()
+  | otherwise = do
+      createDirectoryIfMissing True outPath
+
+      -- write out all maps
+      mapM_
+        (\(path,out) -> encodeFile (outPath </> path) $ mapresultAdjusted out)
+        (toList $ dirresultMaps result)
+
+      -- 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
+          putStrLn $ "copying " <> assetPath <> " → " <> newPath
+          copyFile assetPath newPath