aboutsummaryrefslogtreecommitdiff
path: root/compiler/src
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/src')
-rw-r--r--compiler/src/Processors.hs21
-rw-r--r--compiler/src/Resource.hs28
2 files changed, 37 insertions, 12 deletions
diff --git a/compiler/src/Processors.hs b/compiler/src/Processors.hs
index df7e632..fc719af 100644
--- a/compiler/src/Processors.hs
+++ b/compiler/src/Processors.hs
@@ -27,16 +27,17 @@ module Processors
27import Control.Exception (Exception) 27import Control.Exception (Exception)
28import Data.Function ((&)) 28import Data.Function ((&))
29import Data.Char (toLower) 29import Data.Char (toLower)
30import Data.List (break)
30 31
31import System.Directory hiding (copyFile) 32import System.Directory hiding (copyFile)
32import qualified System.Directory 33import qualified System.Directory
33import System.FilePath 34import System.FilePath
34 35
35import System.Process (callProcess) 36import System.Process (callProcess, readProcess)
36 37
37import Resource 38import Resource
38 ( ItemProcessor, ThumbnailProcessor 39 ( ItemProcessor, ThumbnailProcessor
39 , GalleryItemProps(..), Resolution(..), Resource(..) ) 40 , GalleryItemProps(..), Resolution(..), Resource(..), Thumbnail(..) )
40 41
41import Files 42import Files
42 43
@@ -123,6 +124,12 @@ withCached processor inputPath outputPath =
123resourceAt :: FilePath -> Path -> IO Resource 124resourceAt :: FilePath -> Path -> IO Resource
124resourceAt fsPath resPath = getModificationTime fsPath >>= return . Resource resPath 125resourceAt fsPath resPath = getModificationTime fsPath >>= return . Resource resPath
125 126
127getImageResolution :: FilePath -> IO Resolution
128getImageResolution fsPath =
129 readProcess "identify" ["-format", "%w %h", fsPath] []
130 >>= return . break (== ' ')
131 >>= return . \(w, h) -> Resolution (read w) (read h)
132
126 133
127type ItemFileProcessor = 134type ItemFileProcessor =
128 FileName -- ^ Input base path 135 FileName -- ^ Input base path
@@ -162,12 +169,14 @@ thumbnailFileProcessor maxRes cached inputBase outputBase resClass inputRes =
162 inPath = localPath $ inputBase /> inputRes 169 inPath = localPath $ inputBase /> inputRes
163 outPath = localPath $ outputBase /> relOutPath 170 outPath = localPath $ outputBase /> relOutPath
164 171
165 process :: Maybe FileProcessor -> IO (Maybe Resource) 172 process :: Maybe FileProcessor -> IO (Maybe Thumbnail)
166 process Nothing = return Nothing 173 process Nothing = return Nothing
167 process (Just proc) = 174 process (Just proc) =
168 proc inPath outPath 175 do
169 >> resourceAt outPath relOutPath 176 proc inPath outPath
170 >>= return . Just 177 resource <- resourceAt outPath relOutPath
178 resolution <- getImageResolution outPath
179 return $ Just $ Thumbnail resource resolution
171 180
172 processorFor :: Format -> Maybe FileProcessor 181 processorFor :: Format -> Maybe FileProcessor
173 processorFor PictureFormat = Just $ resizePictureUpTo maxRes 182 processorFor PictureFormat = Just $ resizePictureUpTo maxRes
diff --git a/compiler/src/Resource.hs b/compiler/src/Resource.hs
index 599509e..400e18a 100644
--- a/compiler/src/Resource.hs
+++ b/compiler/src/Resource.hs
@@ -18,7 +18,7 @@
18 18
19module Resource 19module Resource
20 ( ItemProcessor, ThumbnailProcessor 20 ( ItemProcessor, ThumbnailProcessor
21 , GalleryItem(..), GalleryItemProps(..), Resolution(..), Resource(..) 21 , GalleryItem(..), GalleryItemProps(..), Resolution(..), Resource(..), Thumbnail(..)
22 , buildGalleryTree, galleryCleanupResourceDir 22 , buildGalleryTree, galleryCleanupResourceDir
23 ) where 23 ) where
24 24
@@ -90,13 +90,23 @@ instance ToJSON GalleryItemProps where
90 toEncoding = genericToEncoding encodingOptions 90 toEncoding = genericToEncoding encodingOptions
91 91
92 92
93data Thumbnail = Thumbnail
94 { resource :: Resource
95 , resolution :: Resolution
96 } deriving (Generic, Show)
97
98instance ToJSON Thumbnail where
99 toJSON = genericToJSON encodingOptions
100 toEncoding = genericToEncoding encodingOptions
101
102
93data GalleryItem = GalleryItem 103data GalleryItem = GalleryItem
94 { title :: String 104 { title :: String
95 , datetime :: ZonedTime 105 , datetime :: ZonedTime
96 , description :: String 106 , description :: String
97 , tags :: [Tag] 107 , tags :: [Tag]
98 , path :: Path 108 , path :: Path
99 , thumbnail :: Maybe Resource 109 , thumbnail :: Maybe Thumbnail
100 , properties :: GalleryItemProps 110 , properties :: GalleryItemProps
101 } deriving (Generic, Show) 111 } deriving (Generic, Show)
102 112
@@ -106,7 +116,7 @@ instance ToJSON GalleryItem where
106 116
107 117
108type ItemProcessor = Path -> IO GalleryItemProps 118type ItemProcessor = Path -> IO GalleryItemProps
109type ThumbnailProcessor = Path -> IO (Maybe Resource) 119type ThumbnailProcessor = Path -> IO (Maybe Thumbnail)
110 120
111 121
112buildGalleryTree :: 122buildGalleryTree ::
@@ -150,7 +160,7 @@ buildGalleryTree processItem processThumbnail tagsFromDirectories galleryName in
150 subItemsParents :: [String] 160 subItemsParents :: [String]
151 subItemsParents = (maybeToList $ fileName path) ++ parentTitles 161 subItemsParents = (maybeToList $ fileName path) ++ parentTitles
152 162
153 maybeThumbnail :: Maybe Path -> IO (Maybe Resource) 163 maybeThumbnail :: Maybe Path -> IO (Maybe Thumbnail)
154 maybeThumbnail Nothing = return Nothing 164 maybeThumbnail Nothing = return Nothing
155 maybeThumbnail (Just thumbnailPath) = processThumbnail thumbnailPath 165 maybeThumbnail (Just thumbnailPath) = processThumbnail thumbnailPath
156 166
@@ -197,10 +207,16 @@ galleryOutputDiff resources ref =
197 207
198 resPath :: GalleryItemProps -> Maybe Path 208 resPath :: GalleryItemProps -> Maybe Path
199 resPath Directory{} = Nothing 209 resPath Directory{} = Nothing
200 resPath resourceProps = Just (resourcePath $ resource resourceProps) 210 resPath resourceProps =
211 Just
212 $ resourcePath
213 $ (resource :: (GalleryItemProps -> Resource)) resourceProps
201 214
202 thumbnailPaths :: [GalleryItem] -> [Path] 215 thumbnailPaths :: [GalleryItem] -> [Path]
203 thumbnailPaths = (map resourcePath) . (mapMaybe thumbnail) 216 thumbnailPaths =
217 map resourcePath
218 . map (resource :: (Thumbnail -> Resource))
219 . mapMaybe thumbnail
204 220
205 (\\) :: [Path] -> [Path] -> [Path] 221 (\\) :: [Path] -> [Path] -> [Path]
206 a \\ b = minusOn orderedForm (sortOn orderedForm a) (sortOn orderedForm b) 222 a \\ b = minusOn orderedForm (sortOn orderedForm a) (sortOn orderedForm b)