aboutsummaryrefslogtreecommitdiff
path: root/compiler/src/Input.hs
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/src/Input.hs')
-rw-r--r--compiler/src/Input.hs95
1 files changed, 95 insertions, 0 deletions
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
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 Input
23 ( Sidecar, title, date, description, tags
24 , InputTree(..), readInputTree
25 ) where
26
27
28import GHC.Generics (Generic)
29import Control.Exception (Exception, throwIO)
30import Control.Monad.IO.Class (MonadIO, liftIO)
31import Data.Function ((&))
32import Data.Maybe (mapMaybe, catMaybes)
33import Data.List (find)
34import Data.Yaml (ParseException, decodeFileEither)
35import Data.Aeson (FromJSON)
36import System.FilePath (isExtensionOf, dropExtension)
37
38import Files
39import Utils
40
41
42data LoadException = LoadException String ParseException deriving Show
43instance Exception LoadException
44
45decodeYamlFile :: (MonadIO m, FromJSON a) => Path -> m a
46decodeYamlFile path =
47 liftIO $ Data.Yaml.decodeFileEither fpath
48 >>= either (throwIO . LoadException fpath) return
49 where
50 fpath = localPath path
51
52
53-- | Tree representing the input from the input directory.
54data InputTree =
55 InputFile
56 { path :: Path
57 , sidecar :: Sidecar }
58 | InputDir
59 { path :: Path
60 , thumbnailPath :: Maybe Path
61 , items :: [InputTree] }
62 deriving Show
63
64data Sidecar = Sidecar
65 { title :: Maybe String
66 , date :: Maybe String
67 , description :: Maybe String
68 , tags :: Maybe [String]
69 } deriving (Generic, FromJSON, Show)
70
71
72readInputTree :: AnchoredFSNode -> IO InputTree
73readInputTree (AnchoredFSNode anchor root@Dir{}) =
74 filterDir (neg isHidden) root & mkDirNode
75 where
76 mkInputNode :: FSNode -> IO (Maybe InputTree)
77 mkInputNode (File path@(filename:pathto)) | ".yaml" `isExtensionOf` filename =
78 decodeYamlFile (anchor /> path)
79 >>= return . InputFile ((dropExtension filename):pathto)
80 >>= return . Just
81 mkInputNode File{} = return Nothing
82 mkInputNode dir@Dir{} = mkDirNode dir >>= return . Just
83
84 mkDirNode :: FSNode -> IO InputTree
85 mkDirNode (Dir path items) =
86 mapM mkInputNode items
87 >>= return . catMaybes
88 >>= return . InputDir path (findThumbnail items)
89 where
90 findThumbnail :: [FSNode] -> Maybe Path
91 findThumbnail = (fmap nodePath) . (find matchThumbnail)
92
93 matchThumbnail :: FSNode -> Bool
94 matchThumbnail Dir{} = False
95 matchThumbnail (File (filename:_)) = (dropExtension filename) == "thumbnail"