From 4fde03c7654dcdad11a8c91ba2bcbb2706695e11 Mon Sep 17 00:00:00 2001
From: pacien
Date: Thu, 30 Jan 2020 16:03:54 +0100
Subject: compiler: properly exclude out directory

Use canonical paths to exclude the output directory if it is located
inside the input directory instead of guessing based on special files.

GitHub: closes #54
---
 compiler/src/Files.hs | 49 ++++++++++++++++++++++++++++++-------------------
 1 file changed, 30 insertions(+), 19 deletions(-)

(limited to 'compiler/src/Files.hs')

diff --git a/compiler/src/Files.hs b/compiler/src/Files.hs
index 41fc5a8..8ea943f 100644
--- a/compiler/src/Files.hs
+++ b/compiler/src/Files.hs
@@ -29,7 +29,6 @@ module Files
 
 
 import Control.Monad (mapM)
-import Data.Bool (bool)
 import Data.List (isPrefixOf, length, subsequences)
 import Data.Function ((&))
 import Data.Text (pack)
@@ -39,6 +38,7 @@ import qualified Data.Aeson as JSON
 import System.Directory
   ( doesDirectoryExist
   , doesPathExist
+  , canonicalizePath
   , getModificationTime
   , listDirectory
   , createDirectoryIfMissing
@@ -94,8 +94,13 @@ webPath (Path path) = System.FilePath.Posix.joinPath $ reverse path
 
 
 data FSNode =
-    File { path :: Path }
-  | Dir { path :: Path, items :: [FSNode] }
+    File
+      { path :: Path
+      , canonicalPath :: FilePath }
+  | Dir
+      { path :: Path
+      , canonicalPath :: FilePath
+      , items :: [FSNode] }
   deriving Show
 
 data AnchoredFSNode = AnchoredFSNode
@@ -115,8 +120,8 @@ isHidden = hiddenName . nodeName
 
 -- | DFS with intermediate dirs first.
 flattenDir :: FSNode -> [FSNode]
-flattenDir file@(File _) = [file]
-flattenDir dir@(Dir _ items) = dir:(concatMap flattenDir items)
+flattenDir file@File{} = [file]
+flattenDir dir@Dir{items} = dir:(concatMap flattenDir items)
 
 -- | Filters a dir tree. The root is always returned.
 filterDir :: (FSNode -> Bool) -> AnchoredFSNode -> AnchoredFSNode
@@ -124,35 +129,41 @@ filterDir cond (AnchoredFSNode anchor root) =
   AnchoredFSNode anchor (filterNode root)
   where
   filterNode :: FSNode -> FSNode
-  filterNode file@(File _) = file
-  filterNode (Dir path items) =
-    filter cond items & map filterNode & Dir path
+  filterNode file@File{} = file
+  filterNode Dir{path, canonicalPath, items} =
+    filter cond items & map filterNode & Dir path canonicalPath
 
 readDirectory :: LocalPath -> IO AnchoredFSNode
 readDirectory root = mkNode (Path []) >>= return . AnchoredFSNode root
   where
     mkNode :: Path -> IO FSNode
     mkNode path =
-      (doesDirectoryExist $ localPath (root /> path))
-      >>= bool (mkFileNode path) (mkDirNode path)
-
-    mkFileNode :: Path -> IO FSNode
-    mkFileNode path = return $ File path
-
-    mkDirNode :: Path -> IO FSNode
-    mkDirNode path =
+      do
+        let relPath = localPath (root /> path)
+        canonicalPath <- canonicalizePath relPath
+        isDir <- doesDirectoryExist relPath
+        if isDir then
+          mkDirNode path canonicalPath
+        else
+          mkFileNode path canonicalPath
+
+    mkFileNode :: Path -> FilePath -> IO FSNode
+    mkFileNode path canonicalPath = return $ File path canonicalPath
+
+    mkDirNode :: Path -> FilePath -> IO FSNode
+    mkDirNode path canonicalPath =
       (listDirectory $ localPath (root /> path))
       >>= mapM (mkNode . ((</) path))
-      >>= return . Dir path
+      >>= return . Dir path canonicalPath
 
 copyTo :: FilePath -> AnchoredFSNode -> IO ()
 copyTo target AnchoredFSNode{anchor, root} = copyNode root
   where
     copyNode :: FSNode -> IO ()
-    copyNode (File path) =
+    copyNode File{path} =
       copyFile (localPath $ anchor /> path) (localPath $ target /> path)
 
-    copyNode (Dir path items) =
+    copyNode Dir{path, items} =
       createDirectoryIfMissing True (localPath $ target /> path)
       >> mapM_ copyNode items
 
-- 
cgit v1.2.3


From 7a8bad610472a0197f990dd5f28829f73fc0346e Mon Sep 17 00:00:00 2001
From: pacien
Date: Thu, 13 Feb 2020 22:12:20 +0100
Subject: compiler: stabilise item order in index

By sorting directory items alphabetically.

GitHub: closes #119
---
 compiler/src/Files.hs | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

(limited to 'compiler/src/Files.hs')

diff --git a/compiler/src/Files.hs b/compiler/src/Files.hs
index 8ea943f..8a53b84 100644
--- a/compiler/src/Files.hs
+++ b/compiler/src/Files.hs
@@ -29,7 +29,7 @@ module Files
 
 
 import Control.Monad (mapM)
-import Data.List (isPrefixOf, length, subsequences)
+import Data.List (isPrefixOf, length, subsequences, sortOn)
 import Data.Function ((&))
 import Data.Text (pack)
 import Data.Aeson (ToJSON)
@@ -154,6 +154,7 @@ readDirectory root = mkNode (Path []) >>= return . AnchoredFSNode root
     mkDirNode path canonicalPath =
       (listDirectory $ localPath (root /> path))
       >>= mapM (mkNode . ((</) path))
+      >>= return . sortOn nodeName
       >>= return . Dir path canonicalPath
 
 copyTo :: FilePath -> AnchoredFSNode -> IO ()
-- 
cgit v1.2.3


From 934859af018802be8a2657281aa35d51f91a83a0 Mon Sep 17 00:00:00 2001
From: pacien
Date: Sun, 16 Feb 2020 22:48:53 +0100
Subject: compiler: fix doc comment

(cherry picked from commit 4a6138c89b838c85ede2b3c341c59676580e1043)
---
 compiler/src/Files.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

(limited to 'compiler/src/Files.hs')

diff --git a/compiler/src/Files.hs b/compiler/src/Files.hs
index 8a53b84..a45e8aa 100644
--- a/compiler/src/Files.hs
+++ b/compiler/src/Files.hs
@@ -53,7 +53,7 @@ type FileName = String
 type LocalPath = String
 type WebPath = String
 
- -- | Reversed path component list
+-- | Reversed path component list
 data Path = Path [FileName] deriving Show
 
 instance ToJSON Path where
-- 
cgit v1.2.3


From b04c5a58f449db6f8de0e837ffed1e087238787d Mon Sep 17 00:00:00 2001
From: pacien
Date: Sat, 25 Apr 2020 21:34:00 +0200
Subject: compiler: bump stackage lts to 15.9

---
 compiler/src/Files.hs | 1 -
 1 file changed, 1 deletion(-)

(limited to 'compiler/src/Files.hs')

diff --git a/compiler/src/Files.hs b/compiler/src/Files.hs
index a45e8aa..c769815 100644
--- a/compiler/src/Files.hs
+++ b/compiler/src/Files.hs
@@ -28,7 +28,6 @@ module Files
   ) where
 
 
-import Control.Monad (mapM)
 import Data.List (isPrefixOf, length, subsequences, sortOn)
 import Data.Function ((&))
 import Data.Text (pack)
-- 
cgit v1.2.3