diff options
Diffstat (limited to 'compiler/src')
-rw-r--r-- | compiler/src/Files.hs | 104 | ||||
-rw-r--r-- | compiler/src/Gallery.hs | 123 | ||||
-rw-r--r-- | compiler/src/Input.hs | 95 | ||||
-rw-r--r-- | compiler/src/Lib.hs | 251 | ||||
-rw-r--r-- | compiler/src/Resource.hs | 58 | ||||
-rw-r--r-- | compiler/src/Utils.hs | 49 |
6 files changed, 461 insertions, 219 deletions
diff --git a/compiler/src/Files.hs b/compiler/src/Files.hs new file mode 100644 index 0000000..7948842 --- /dev/null +++ b/compiler/src/Files.hs | |||
@@ -0,0 +1,104 @@ | |||
1 | {-# LANGUAGE DuplicateRecordFields, DeriveGeneric #-} | ||
2 | |||
3 | -- ldgallery - A static generator which turns a collection of tagged | ||
4 | -- pictures into a searchable web gallery. | ||
5 | -- | ||
6 | -- Copyright (C) 2019 Pacien TRAN-GIRARD | ||
7 | -- | ||
8 | -- This program is free software: you can redistribute it and/or modify | ||
9 | -- it under the terms of the GNU Affero General Public License as | ||
10 | -- published by the Free Software Foundation, either version 3 of the | ||
11 | -- License, or (at your option) any later version. | ||
12 | -- | ||
13 | -- This program is distributed in the hope that it will be useful, | ||
14 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
15 | -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
16 | -- GNU Affero General Public License for more details. | ||
17 | -- | ||
18 | -- You should have received a copy of the GNU Affero General Public License | ||
19 | -- along with this program. If not, see <https://www.gnu.org/licenses/>. | ||
20 | |||
21 | |||
22 | module Files | ||
23 | ( FileName, LocalPath, WebPath, Path | ||
24 | , (</>), (</), (/>), localPath, webPath | ||
25 | , FSNode(..), AnchoredFSNode(..) | ||
26 | , nodePath, nodeName, isHidden, flatten, filterDir, readDirectory | ||
27 | ) where | ||
28 | |||
29 | |||
30 | import Control.Monad (filterM, mapM) | ||
31 | import Data.Bool (bool) | ||
32 | import Data.List (isPrefixOf, length, deleteBy) | ||
33 | import Data.Function ((&)) | ||
34 | import System.Directory (doesDirectoryExist, listDirectory) | ||
35 | import qualified System.FilePath | ||
36 | import qualified System.FilePath.Posix | ||
37 | import Utils | ||
38 | |||
39 | |||
40 | type FileName = String | ||
41 | type LocalPath = String | ||
42 | type WebPath = String | ||
43 | |||
44 | -- | Reversed path component list | ||
45 | type Path = [FileName] | ||
46 | |||
47 | (</>) :: Path -> Path -> Path | ||
48 | l </> r = r ++ l | ||
49 | |||
50 | (</) :: Path -> FileName -> Path | ||
51 | path </ file = file:path | ||
52 | |||
53 | (/>) :: FileName -> Path -> Path | ||
54 | file /> path = path ++ [file] | ||
55 | |||
56 | localPath :: Path -> LocalPath | ||
57 | localPath = System.FilePath.joinPath . reverse | ||
58 | |||
59 | webPath :: Path -> WebPath | ||
60 | webPath = System.FilePath.Posix.joinPath . reverse | ||
61 | |||
62 | |||
63 | data FSNode = File Path | Dir Path [FSNode] deriving Show | ||
64 | data AnchoredFSNode = AnchoredFSNode | ||
65 | { anchor :: LocalPath | ||
66 | , root :: FSNode } deriving Show | ||
67 | |||
68 | nodePath :: FSNode -> Path | ||
69 | nodePath (File path) = path | ||
70 | nodePath (Dir path _) = path | ||
71 | |||
72 | nodeName :: FSNode -> FileName | ||
73 | nodeName = head . nodePath | ||
74 | |||
75 | isHidden :: FSNode -> Bool | ||
76 | isHidden node = "." `isPrefixOf` filename && length filename > 1 | ||
77 | where filename = nodeName node | ||
78 | |||
79 | flatten :: FSNode -> [FSNode] | ||
80 | flatten file@(File _) = [file] | ||
81 | flatten dir@(Dir _ childs) = dir:(concatMap flatten childs) | ||
82 | |||
83 | -- | Filters a dir tree. The root is always returned. | ||
84 | filterDir :: (FSNode -> Bool) -> FSNode -> FSNode | ||
85 | filterDir _ file@(File _) = file | ||
86 | filterDir cond (Dir path childs) = | ||
87 | filter cond childs & map (filterDir cond) & Dir path | ||
88 | |||
89 | readDirectory :: LocalPath -> IO AnchoredFSNode | ||
90 | readDirectory root = mkNode [""] >>= return . AnchoredFSNode root | ||
91 | where | ||
92 | mkNode :: Path -> IO FSNode | ||
93 | mkNode path = | ||
94 | (doesDirectoryExist $ localPath (root /> path)) | ||
95 | >>= bool (mkFileNode path) (mkDirNode path) | ||
96 | |||
97 | mkFileNode :: Path -> IO FSNode | ||
98 | mkFileNode path = return $ File path | ||
99 | |||
100 | mkDirNode :: Path -> IO FSNode | ||
101 | mkDirNode path = | ||
102 | (listDirectory $ localPath (root /> path)) | ||
103 | >>= mapM (mkNode . ((</) path)) | ||
104 | >>= return . Dir path | ||
diff --git a/compiler/src/Gallery.hs b/compiler/src/Gallery.hs new file mode 100644 index 0000000..3be62ad --- /dev/null +++ b/compiler/src/Gallery.hs | |||
@@ -0,0 +1,123 @@ | |||
1 | {-# LANGUAGE DuplicateRecordFields, DeriveGeneric, DeriveAnyClass #-} | ||
2 | |||
3 | -- ldgallery - A static generator which turns a collection of tagged | ||
4 | -- pictures into a searchable web gallery. | ||
5 | -- | ||
6 | -- Copyright (C) 2019 Pacien TRAN-GIRARD | ||
7 | -- | ||
8 | -- This program is free software: you can redistribute it and/or modify | ||
9 | -- it under the terms of the GNU Affero General Public License as | ||
10 | -- published by the Free Software Foundation, either version 3 of the | ||
11 | -- License, or (at your option) any later version. | ||
12 | -- | ||
13 | -- This program is distributed in the hope that it will be useful, | ||
14 | -- but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
15 | -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
16 | -- GNU Affero General Public License for more details. | ||
17 | -- | ||
18 | -- You should have received a copy of the GNU Affero General Public License | ||
19 | -- along with this program. If not, see <https://www.gnu.org/licenses/>. | ||
20 | |||
21 | |||
22 | module Gallery | ||
23 | ( GalleryItem(..), buildGalleryTree | ||
24 | ) where | ||
25 | |||
26 | |||
27 | import GHC.Generics (Generic) | ||
28 | import Data.Char (toLower) | ||
29 | import Data.Function ((&)) | ||
30 | import Data.Maybe (fromMaybe) | ||
31 | |||
32 | import Data.Aeson (ToJSON, genericToJSON, genericToEncoding) | ||
33 | import qualified Data.Aeson as JSON | ||
34 | |||
35 | importĀ Utils | ||
36 | import Files | ||
37 | import Input | ||
38 | import Resource | ||
39 | |||
40 | |||
41 | encodingOptions :: JSON.Options | ||
42 | encodingOptions = JSON.defaultOptions | ||
43 | { JSON.fieldLabelModifier = map toLower | ||
44 | , JSON.constructorTagModifier = map toLower | ||
45 | , JSON.sumEncoding = JSON.defaultTaggedObject | ||
46 | { JSON.tagFieldName = "type" | ||
47 | , JSON.contentsFieldName = "contents" | ||
48 | } | ||
49 | } | ||
50 | |||
51 | |||
52 | type ResourcePath = String | ||
53 | type Tag = String | ||
54 | type FileSizeKB = Int | ||
55 | |||
56 | |||
57 | data Resolution = Resolution | ||
58 | { width :: Int | ||
59 | , height :: Int | ||
60 | } deriving (Generic, Show) | ||
61 | |||
62 | instance ToJSON Resolution where | ||
63 | toJSON = genericToJSON encodingOptions | ||
64 | toEncoding = genericToEncoding encodingOptions | ||
65 | |||
66 | |||
67 | data GalleryItemProps = | ||
68 | Directory { items :: [GalleryItem] } | ||
69 | -- | Image { resolution :: Resolution, filesize :: FileSizeKB } | ||
70 | -- | Video { filesize :: FileSizeKB } | ||
71 | | Unknown | ||
72 | deriving (Generic, Show) | ||
73 | |||
74 | instance ToJSON GalleryItemProps where | ||
75 | toJSON = genericToJSON encodingOptions | ||
76 | toEncoding = genericToEncoding encodingOptions | ||
77 | |||
78 | |||
79 | -- TODO: fuse GalleryItem and GalleryItemProps | ||
80 | data GalleryItem = GalleryItem | ||
81 | { title :: String | ||
82 | , date :: String -- TODO: checked ISO8601 date | ||
83 | , description :: String | ||
84 | , tags :: [Tag] | ||
85 | , path :: ResourcePath | ||
86 | , thumbnail :: Maybe ResourcePath | ||
87 | , properties :: GalleryItemProps | ||
88 | } deriving (Generic, Show) | ||
89 | |||
90 | instance ToJSON GalleryItem where | ||
91 | toJSON = genericToJSON encodingOptions | ||
92 | toEncoding = genericToEncoding encodingOptions | ||
93 | |||
94 | |||
95 | buildGalleryTree :: ResourceTree -> GalleryItem | ||
96 | buildGalleryTree (ItemResource sidecar path@(filename:_) thumbnailPath) = | ||
97 | GalleryItem | ||
98 | { title = optMeta title filename | ||
99 | , date = optMeta date "" -- TODO: check and normalise dates | ||
100 | , description = optMeta description "" | ||
101 | , tags = optMeta tags [] | ||
102 | , path = webPath path | ||
103 | , thumbnail = Just $ webPath thumbnailPath | ||
104 | , properties = Unknown } -- TODO | ||
105 | where | ||
106 | optMeta :: (Sidecar -> Maybe a) -> a -> a | ||
107 | optMeta get fallback = fromMaybe fallback $ get sidecar | ||
108 | |||
109 | buildGalleryTree (DirResource dirItems path@(dirname:_) thumbnailPath) = | ||
110 | map buildGalleryTree dirItems | ||
111 | & \items -> GalleryItem | ||
112 | { title = dirname | ||
113 | -- TODO: consider using the most recent item's date? what if empty? | ||
114 | , date = "" | ||
115 | -- TODO: consider allowing metadata sidecars for directories too | ||
116 | , description = "" | ||
117 | , tags = aggregateChildTags items | ||
118 | , path = webPath path | ||
119 | , thumbnail = fmap webPath thumbnailPath | ||
120 | , properties = Directory items } | ||
121 | where | ||
122 | aggregateChildTags :: [GalleryItem] -> [Tag] | ||
123 | aggregateChildTags = unique . concatMap (\item -> tags (item::GalleryItem)) | ||
diff --git a/compiler/src/Input.hs b/compiler/src/Input.hs new file mode 100644 index 0000000..78622bf --- /dev/null +++ b/compiler/src/Input.hs | |||
@@ -0,0 +1,95 @@ | |||
1 | {-# LANGUAGE DuplicateRecordFields, DeriveGeneric, DeriveAnyClass #-} | ||
2 | |||
3 | -- ldgallery - A static generator which turns a collection of tagged | ||
4 | -- pictures into a searchable web gallery. | ||
5 | -- | ||
6 | -- Copyright (C) 2019 Pacien TRAN-GIRARD | ||
7 | -- | ||
8 | -- This program is free software: you can redistribute it and/or modify | ||