diff options
Diffstat (limited to 'compiler/src')
-rw-r--r-- | compiler/src/Config.hs (renamed from compiler/src/Utils.hs) | 42 | ||||
-rw-r--r-- | compiler/src/Gallery.hs | 6 | ||||
-rw-r--r-- | compiler/src/Input.hs | 3 | ||||
-rw-r--r-- | compiler/src/Lib.hs | 35 |
4 files changed, 38 insertions, 48 deletions
diff --git a/compiler/src/Utils.hs b/compiler/src/Config.hs index 794382c..6f04818 100644 --- a/compiler/src/Utils.hs +++ b/compiler/src/Config.hs | |||
@@ -1,3 +1,5 @@ | |||
1 | {-# LANGUAGE DuplicateRecordFields, DeriveGeneric, DeriveAnyClass #-} | ||
2 | |||
1 | -- ldgallery - A static generator which turns a collection of tagged | 3 | -- ldgallery - A static generator which turns a collection of tagged |
2 | -- pictures into a searchable web gallery. | 4 | -- pictures into a searchable web gallery. |
3 | -- | 5 | -- |
@@ -17,33 +19,31 @@ | |||
17 | -- along with this program. If not, see <https://www.gnu.org/licenses/>. | 19 | -- along with this program. If not, see <https://www.gnu.org/licenses/>. |
18 | 20 | ||
19 | 21 | ||
20 | module Utils | 22 | module Config |
21 | ( conj, neg | 23 | ( GalleryConfig(..) |
22 | , unique | 24 | , CompilerConfig(..) |
23 | , passthrough | 25 | , readConfig |
24 | ) where | 26 | ) where |
25 | 27 | ||
28 | import GHC.Generics (Generic) | ||
29 | import Data.Aeson (ToJSON, FromJSON) | ||
30 | import qualified Data.Aeson as JSON | ||
26 | 31 | ||
27 | import qualified Data.List | 32 | import Files (FileName) |
28 | import qualified Data.Set | 33 | import Input (decodeYamlFile) |
29 | |||
30 | |||
31 | -- predicates | ||
32 | |||
33 | conj :: (a -> Bool) -> (a -> Bool) -> a -> Bool | ||
34 | conj p q x = (p x) && (q x) | ||
35 | |||
36 | neg :: (a -> Bool) -> a -> Bool | ||
37 | neg p x = not (p x) | ||
38 | 34 | ||
39 | 35 | ||
40 | -- lists | 36 | data CompilerConfig = CompilerConfig |
37 | { dummy :: Maybe String -- TODO | ||
38 | } deriving (Generic, FromJSON, Show) | ||
41 | 39 | ||
42 | unique :: Ord a => [a] -> [a] | 40 | data GalleryConfig = GalleryConfig |
43 | unique = Data.Set.toList . Data.Set.fromList | 41 | { compiler :: CompilerConfig |
42 | , viewer :: JSON.Object | ||
43 | } deriving (Generic, FromJSON, Show) | ||
44 | 44 | ||
45 | -- TODO: add compiler config keys and their default values | ||
45 | 46 | ||
46 | -- monads | ||
47 | 47 | ||
48 | passthrough :: Monad m => (a -> m b) -> a -> m a | 48 | readConfig :: FileName -> IO GalleryConfig |
49 | passthrough f a = return a >>= f >>= \_ -> return a | 49 | readConfig = decodeYamlFile |
diff --git a/compiler/src/Gallery.hs b/compiler/src/Gallery.hs index 3be62ad..ce52523 100644 --- a/compiler/src/Gallery.hs +++ b/compiler/src/Gallery.hs | |||
@@ -32,7 +32,8 @@ import Data.Maybe (fromMaybe) | |||
32 | import Data.Aeson (ToJSON, genericToJSON, genericToEncoding) | 32 | import Data.Aeson (ToJSON, genericToJSON, genericToEncoding) |
33 | import qualified Data.Aeson as JSON | 33 | import qualified Data.Aeson as JSON |
34 | 34 | ||
35 | importĀ Utils | 35 | import qualified Data.Set as Set |
36 | |||
36 | import Files | 37 | import Files |
37 | import Input | 38 | import Input |
38 | import Resource | 39 | import Resource |
@@ -121,3 +122,6 @@ buildGalleryTree (DirResource dirItems path@(dirname:_) thumbnailPath) = | |||
121 | where | 122 | where |
122 | aggregateChildTags :: [GalleryItem] -> [Tag] | 123 | aggregateChildTags :: [GalleryItem] -> [Tag] |
123 | aggregateChildTags = unique . concatMap (\item -> tags (item::GalleryItem)) | 124 | aggregateChildTags = unique . concatMap (\item -> tags (item::GalleryItem)) |
125 | |||
126 | unique :: Ord a => [a] -> [a] | ||
127 | unique = Set.toList . Set.fromList | ||
diff --git a/compiler/src/Input.hs b/compiler/src/Input.hs index fa36d59..681f169 100644 --- a/compiler/src/Input.hs +++ b/compiler/src/Input.hs | |||
@@ -37,7 +37,6 @@ import Data.Aeson (FromJSON) | |||
37 | import System.FilePath (isExtensionOf, dropExtension) | 37 | import System.FilePath (isExtensionOf, dropExtension) |
38 | 38 | ||
39 | import Files | 39 | import Files |
40 | import Utils | ||
41 | 40 | ||
42 | 41 | ||
43 | data LoadException = LoadException String ParseException deriving Show | 42 | data LoadException = LoadException String ParseException deriving Show |
@@ -70,7 +69,7 @@ data Sidecar = Sidecar | |||
70 | 69 | ||
71 | readInputTree :: AnchoredFSNode -> IO InputTree | 70 | readInputTree :: AnchoredFSNode -> IO InputTree |
72 | readInputTree (AnchoredFSNode anchor root@Dir{}) = | 71 | readInputTree (AnchoredFSNode anchor root@Dir{}) = |
73 | filterDir (neg isHidden) root & mkDirNode | 72 | filterDir (not . isHidden) root & mkDirNode |
74 | where | 73 | where |
75 | mkInputNode :: FSNode -> IO (Maybe InputTree) | 74 | mkInputNode :: FSNode -> IO (Maybe InputTree) |
76 | mkInputNode (File path@(filename:pathto)) | ".yaml" `isExtensionOf` filename = | 75 | mkInputNode (File path@(filename:pathto)) | ".yaml" `isExtensionOf` filename = |
diff --git a/compiler/src/Lib.hs b/compiler/src/Lib.hs index 643e5f6..b2bbe15 100644 --- a/compiler/src/Lib.hs +++ b/compiler/src/Lib.hs | |||
@@ -24,47 +24,28 @@ module Lib | |||
24 | ) where | 24 | ) where |
25 | 25 | ||
26 | 26 | ||
27 | import GHC.Generics (Generic) | ||
28 | import Data.Function ((&)) | 27 | import Data.Function ((&)) |
29 | import Data.Ord (comparing) | 28 | import Data.Ord (comparing) |
30 | import Data.List (sortBy, length) | 29 | import Data.List (sortBy, length) |
31 | import System.Directory (createDirectoryIfMissing, removePathForcibly) | 30 | import System.Directory (createDirectoryIfMissing, removePathForcibly) |
32 | import System.FilePath (dropFileName, (</>)) | 31 | import System.FilePath (dropFileName, (</>)) |
33 | 32 | ||
34 | import Data.Aeson (ToJSON, FromJSON) | 33 | import Data.Aeson (ToJSON) |
35 | import qualified Data.Aeson as JSON | 34 | import qualified Data.Aeson as JSON |
36 | 35 | ||
36 | import Config | ||
37 | import Files (FileName, readDirectory, localPath, flattenDir, root, (/>)) | 37 | import Files (FileName, readDirectory, localPath, flattenDir, root, (/>)) |
38 | import Input (decodeYamlFile, readInputTree) | 38 | import Input (decodeYamlFile, readInputTree) |
39 | import Resource (ResourceTree, buildResourceTree, outputDiff) | 39 | import Resource (ResourceTree, buildResourceTree, outputDiff) |
40 | import Gallery (buildGalleryTree) | 40 | import Gallery (buildGalleryTree) |
41 | 41 | ||
42 | 42 | ||
43 | data CompilerConfig = CompilerConfig | ||
44 | { dummy :: Maybe String -- TODO | ||
45 | } deriving (Generic, FromJSON, Show) | ||
46 | |||
47 | data GalleryConfig = GalleryConfig | ||
48 | { compiler :: CompilerConfig | ||
49 | , viewer :: JSON.Object | ||
50 | } deriving (Generic, FromJSON, Show) | ||
51 | |||
52 | readConfig :: FileName -> IO GalleryConfig | ||
53 | readConfig = decodeYamlFile | ||
54 | |||
55 | |||
56 | process :: FilePath -> FilePath -> IO () | 43 | process :: FilePath -> FilePath -> IO () |
57 | process inputDirPath outputDirPath = | 44 | process inputDirPath outputDirPath = |
58 | do | 45 | do |
59 | config <- readConfig (inputDirPath </> "gallery.yaml") | 46 | config <- readConfig (inputDirPath </> "gallery.yaml") |
60 | |||
61 | inputDir <- readDirectory inputDirPath | 47 | inputDir <- readDirectory inputDirPath |
62 | putStrLn "\nINPUT DIR" | ||
63 | putStrLn (show inputDir) | ||
64 | |||
65 | inputTree <- readInputTree inputDir | 48 | inputTree <- readInputTree inputDir |
66 | putStrLn "\nINPUT TREE" | ||
67 | putStrLn (show inputTree) | ||
68 | 49 | ||
69 | let resourceTree = buildResourceTree inputTree | 50 | let resourceTree = buildResourceTree inputTree |
70 | putStrLn "\nRESOURCE TREE" | 51 | putStrLn "\nRESOURCE TREE" |
@@ -77,11 +58,11 @@ process inputDirPath outputDirPath = | |||
77 | -- (or recompile everything if the config file has changed!) | 58 | -- (or recompile everything if the config file has changed!) |
78 | -- execute in parallel | 59 | -- execute in parallel |
79 | 60 | ||
80 | cleanup resourceTree outputDirPath | ||
81 | |||
82 | -- TODO: execute (in parallel) the resource compilation strategy list | 61 | -- TODO: execute (in parallel) the resource compilation strategy list |
83 | -- need to find a good library for that | 62 | -- need to find a good library for that |
84 | 63 | ||
64 | cleanup resourceTree outputDirPath | ||
65 | |||
85 | buildGalleryTree resourceTree | 66 | buildGalleryTree resourceTree |
86 | & writeJSON (outputDirPath </> "index.json") | 67 | & writeJSON (outputDirPath </> "index.json") |
87 | 68 | ||
@@ -95,7 +76,13 @@ process inputDirPath outputDirPath = | |||
95 | >>= return . outputDiff resourceTree . root | 76 | >>= return . outputDiff resourceTree . root |
96 | >>= return . sortBy (flip $ comparing length) -- nested files before dirs | 77 | >>= return . sortBy (flip $ comparing length) -- nested files before dirs |
97 | >>= return . map (localPath . (/>) outputDir) | 78 | >>= return . map (localPath . (/>) outputDir) |
98 | >>= mapM_ removePathForcibly | 79 | >>= mapM_ remove |
80 | |||
81 | remove :: FileName -> IO () | ||
82 | remove path = | ||
83 | do | ||
84 | putStrLn $ "Removing: " ++ path | ||
85 | removePathForcibly path | ||
99 | 86 | ||
100 | writeJSON :: ToJSON a => FileName -> a -> IO () | 87 | writeJSON :: ToJSON a => FileName -> a -> IO () |
101 | writeJSON path obj = | 88 | writeJSON path obj = |