diff --git a/etienne-moqueur.cabal b/etienne-moqueur.cabal index d0099a7..9f987d8 100644 --- a/etienne-moqueur.cabal +++ b/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 diff --git a/package.yaml b/package.yaml index 623f277..3c9fefc 100644 --- a/package.yaml +++ b/package.yaml @@ -31,6 +31,7 @@ dependencies: - mtl - containers - hashable +- split ghc-options: - -Wall diff --git a/src/Components.hs b/src/Components.hs index 4db80fd..3928512 100644 --- a/src/Components.hs +++ b/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 diff --git a/src/Utils/FileTree.hs b/src/Utils/FileTree.hs new file mode 100644 index 0000000..2c245f9 --- /dev/null +++ b/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 diff --git a/stack.yaml b/stack.yaml index 60d1a09..5cff828 100644 --- a/stack.yaml +++ b/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: {} diff --git a/stack.yaml.lock b/stack.yaml.lock index 43843e5..47ea499 100644 --- a/stack.yaml.lock +++ b/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