aboutsummaryrefslogtreecommitdiff
path: root/compiler
diff options
context:
space:
mode:
Diffstat (limited to 'compiler')
-rw-r--r--compiler/package.yaml10
-rw-r--r--compiler/src/Files.hs104
-rw-r--r--compiler/src/Gallery.hs123
-rw-r--r--compiler/src/Input.hs95
-rw-r--r--compiler/src/Lib.hs251
-rw-r--r--compiler/src/Resource.hs58
-rw-r--r--compiler/src/Utils.hs49
7 files changed, 466 insertions, 224 deletions
diff --git a/compiler/package.yaml b/compiler/package.yaml
index 253f16a..9266466 100644
--- a/compiler/package.yaml
+++ b/compiler/package.yaml
@@ -16,16 +16,16 @@ description: Please see the README on GitHub at <https://github.com/paci
16 16
17dependencies: 17dependencies:
18- base >= 4.7 && < 5 18- base >= 4.7 && < 5
19- text 19#- text
20- containers 20- containers
21- optparse-applicative
22- cmdargs
23- filepath 21- filepath
24- directory 22- directory
25- directory-tree
26- aeson 23- aeson
27- yaml 24- yaml
28- JuicyPixels 25#- optparse-applicative
26#- cmdargs
27#- JuicyPixels
28#- JuicyPixels-extra
29 29
30library: 30library:
31 source-dirs: src 31 source-dirs: src
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
22module Files
23 ( FileName, LocalPath, WebPath, Path
24 , (</>), (</), (/>), localPath, webPath
25 , FSNode(..), AnchoredFSNode(..)
26 , nodePath, nodeName, isHidden, flatten, filterDir, readDirectory
27 ) where
28
29
30import Control.Monad (filterM, mapM)
31import Data.Bool (bool)
32import Data.List (isPrefixOf, length, deleteBy)
33import Data.Function ((&))
34import System.Directory (doesDirectoryExist, listDirectory)
35import qualified System.FilePath
36import qualified System.FilePath.Posix
37import Utils
38
39
40type FileName = String
41type LocalPath = String
42type WebPath = String
43
44 -- | Reversed path component list
45type Path = [FileName]
46
47(</>) :: Path -> Path -> Path
48l </> r = r ++ l
49
50(</) :: Path -> FileName -> Path
51path </ file = file:path
52
53(/>) :: FileName -> Path -> Path
54file /> path = path ++ [file]
55
56localPath :: Path -> LocalPath
57localPath = System.FilePath.joinPath . reverse
58
59webPath :: Path -> WebPath
60webPath = System.FilePath.Posix.joinPath . reverse
61
62
63data FSNode = File Path | Dir Path [FSNode] deriving Show
64data AnchoredFSNode = AnchoredFSNode
65 { anchor :: LocalPath
66 , root :: FSNode } deriving Show
67
68nodePath :: FSNode -> Path
69nodePath (File path) = path
70nodePath (Dir path _) = path
71
72nodeName :: FSNode -> FileName
73nodeName = head . nodePath
74
75isHidden :: FSNode -> Bool
76isHidden node = "." `isPrefixOf` filename && length filename > 1
77 where filename = nodeName node
78
79flatten :: FSNode -> [FSNode]
80flatten file@(File _) = [file]
81flatten dir@(Dir _ childs) = dir:(concatMap flatten childs)
82
83-- | Filters a dir tree. The root is always returned.
84filterDir :: (FSNode -> Bool) -> FSNode -> FSNode
85filterDir _ file@(File _) = file
86filterDir cond (Dir path childs) =
87 filter cond childs & map (filterDir cond) & Dir path
88
89readDirectory :: LocalPath -> IO AnchoredFSNode
90readDirectory 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
22module Gallery
23 ( GalleryItem(..), buildGalleryTree
24 ) where
25
26
27import GHC.Generics (Generic)
28import Data.Char (toLower)
29import Data.Function ((&))
30import Data.Maybe (fromMaybe)
31
32import Data.Aeson (ToJSON, genericToJSON, genericToEncoding)
33import qualified Data.Aeson as JSON
34
35importĀ Utils
36import Files
37import Input
38import Resource
39
40
41encodingOptions :: JSON.Options
42encodingOptions = 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
52type ResourcePath = String
53type Tag = String
54type FileSizeKB = Int
55
56
57data Resolution = Resolution
58 { width :: Int
59 , height :: Int
60 } deriving (Generic, Show)
61
62instance ToJSON Resolution where
63 toJSON = genericToJSON encodingOptions
64 toEncoding = genericToEncoding encodingOptions
65
66
67data GalleryItemProps =
68 Directory { items :: [GalleryItem] }
69-- | Image { resolution :: Resolution, filesize :: FileSizeKB }
70-- | Video { filesize :: FileSizeKB }
71 | Unknown
72 deriving (Generic, Show)
73
74instance ToJSON GalleryItemProps where
75 toJSON = genericToJSON encodingOptions
76 toEncoding = genericToEncoding encodingOptions
77
78
79-- TODO: fuse GalleryItem and GalleryItemProps
80data 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
90instance ToJSON GalleryItem where
91 toJSON = genericToJSON encodingOptions
92 toEncoding = genericToEncoding encodingOptions
93
94
95buildGalleryTree :: ResourceTree -> GalleryItem
96buildGalleryTree (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
10