FileTree Type defined in Utils.FileTree

Trees can be built, merged, and paths extraced. FileTrees have a Monoid
structure.

etienne-moqueur.cabal

@@ -48,6 +48,7 @@ library
       Kit.Templates.Sitemap
       Routes
       Utils.Clay
+      Utils.FileTree
       Utils.XML
   other-modules:
       Paths_etienne_moqueur
@@ -68,6 +69,7 @@ library
     , hakyll
     , hashable
     , mtl
+    , split
     , text
   default-language: Haskell2010
 
@@ -93,6 +95,7 @@ executable etienne-moqueur-exe
     , hakyll
     , hashable
     , mtl
+    , split
     , text
   default-language: Haskell2010
 
@@ -119,5 +122,6 @@ test-suite etienne-moqueur-test
     , hakyll
     , hashable
     , mtl
+    , split
     , text
   default-language: Haskell2010

package.yaml

@@ -31,6 +31,7 @@ dependencies:
 - mtl
 - containers
 - hashable
+- split
 
 ghc-options:
 - -Wall

src/Components.hs

@@ -18,17 +18,20 @@ import qualified Data.Set                      as Set
 import           Data.Text.Lazy                 ( unpack )
 import           Text.Blaze.Html.Renderer.String
 import           Text.Blaze.Html5               ( Html )
+import           Utils.FileTree
 
 --  |Props are data on top of a component's html. They are aggregated when components are combined. The choice of structures for Prop ensures that there is no duplicate at compile time (e.g. the css of a button used 5 times is only rendered once.)
 data Prop = Prop
-  { cssMap :: Map.Map String Css
+  { cssMap     :: Map.Map String Css
+  , assetsTree :: FileTree
   }
 
 instance Semigroup Prop where
-  p1 <> p2 = Prop (Map.union (cssMap p1) (cssMap p2))
+  p1 <> p2 =
+    Prop (Map.union (cssMap p1) (cssMap p2)) (assetsTree p1 <> assetsTree p2)
 
 instance Monoid Prop where
-  mempty = Prop Map.empty
+  mempty = Prop Map.empty mempty
 
 -- |Construct a Prop with a name, css.
 prop :: String -> Css -> Prop

src/Utils/FileTree.hs

@@ -0,0 +1,59 @@
+module Utils.FileTree
+  ( FileTree(..)
+  , build
+  , build'
+  , getPaths
+  ) where
+
+import           Control.Monad
+import           Data.List
+import           Data.List.Split
+import qualified Data.Set                      as Set
+import           Data.Tree
+import           Routes
+
+type FileName = String
+type FileTree = Tree FileName
+
+instance Semigroup FileTree where
+  Node root dirs <> Node root' dirs'
+    | root == root' = Node root $ merge dirs dirs'
+    | otherwise = error "In FileTree Semigroup; cannot merge different folders"
+
+instance Monoid FileTree where
+  mempty = Node "" []
+
+-- |Build a FileTree from a FilePath. The dir separator is '/'.
+build :: FilePath -> FileTree
+build = addNode . splitOn "/"
+ where
+  addNode []       = Node "" []
+  addNode [x     ] = Node x []
+  addNode (x : xs) = Node x [addNode xs]
+
+build' :: Route -> FileTree
+build' = build . path
+
+-- |Merge two lists of Trees by merging Nodes at the same level that have the same value.
+merge :: Ord a => [Tree a] -> [Tree a] -> [Tree a]
+merge list []    = list
+merge []   list' = list'
+merge list list' = case ord of
+  EQ ->
+    Node (rootLabel minimum) (merge (subForest minimum) (subForest minimum'))
+      : merge rest rest'
+  LT -> minimum : merge rest sorted'
+  GT -> minimum' : merge sorted rest'
+ where
+  sorted   = sort list
+  sorted'  = sort list'
+  minimum  = head sorted
+  minimum' = head sorted'
+  rest     = tail sorted
+  rest'    = tail sorted'
+  ord      = compare (rootLabel minimum) (rootLabel minimum')
+
+-- | Extract all different paths from a FileTree, from root to file.
+getPaths :: FileTree -> [FilePath]
+getPaths (Node x [] ) = [x]
+getPaths (Node x txs) = fmap ((x ++) . ("/" ++)) . join . map getPaths $ txs

stack.yaml

@@ -18,7 +18,7 @@
 # resolver: ./custom-snapshot.yaml
 # resolver: https://example.com/snapshots/2018-01-01.yaml
 resolver:
-  url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/19/24.yaml
+  url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/20/26.yaml
 
 # User packages to be built.
 # Various formats can be used as shown in the example below.
@@ -41,6 +41,8 @@ packages:
 #   commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
 #
 # extra-deps: []
+extra-deps: 
+- clay-0.14.0@sha256:382eced24317f9ed0f7a0a4789cdfc6fc8dd32895cdb0c4ea50a1613bee08af3,2128
 
 # Override default flag values for local packages and extra-deps
 # flags: {}

stack.yaml.lock

@@ -3,11 +3,18 @@
 # For more information, please see the documentation at:
 #   https://docs.haskellstack.org/en/stable/lock_files
 
-packages: []
+packages:
+- completed:
+    hackage: clay-0.14.0@sha256:382eced24317f9ed0f7a0a4789cdfc6fc8dd32895cdb0c4ea50a1613bee08af3,2128
+    pantry-tree:
+      sha256: 63de34c432705d98e4309392eb0c3901fec45d4bbf9f0aab750db114467533b1
+      size: 2256
+  original:
+    hackage: clay-0.14.0@sha256:382eced24317f9ed0f7a0a4789cdfc6fc8dd32895cdb0c4ea50a1613bee08af3,2128
 snapshots:
 - completed:
-    size: 619403
-    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/19/24.yaml
-    sha256: 98f5bee5bf07ff25263d7061e03c34595bfca543b611f9d3da5c95f2a6c8d723
+    sha256: 5a59b2a405b3aba3c00188453be172b85893cab8ebc352b1ef58b0eae5d248a2
+    size: 650475
+    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/20/26.yaml
   original:
-    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/19/24.yaml
+    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/20/26.yaml