aboutsummaryrefslogtreecommitdiff
path: root/compiler/src/Resource.hs
diff options
context:
space:
mode:
authorpacien2020-09-25 16:01:49 +0200
committerpacien2020-09-25 16:01:49 +0200
commite93f7b1eb84c083d67567115284c0002a3a7d5fc (patch)
tree8d373e8f7f571485e1330928f43b090ed004c525 /compiler/src/Resource.hs
parent8e3ac8fe44bebb38e1882ca7f06b8100078ad88d (diff)
parentfd542f75a1d94ee5f804d0925823276b97f38581 (diff)
downloadldgallery-e93f7b1eb84c083d67567115284c0002a3a7d5fc.tar.gz
Merge branch 'develop' for release v2.0v2.0
Diffstat (limited to 'compiler/src/Resource.hs')
-rw-r--r--compiler/src/Resource.hs90
1 files changed, 53 insertions, 37 deletions
diff --git a/compiler/src/Resource.hs b/compiler/src/Resource.hs
index e134468..f59eed6 100644
--- a/compiler/src/Resource.hs
+++ b/compiler/src/Resource.hs
@@ -17,9 +17,15 @@
17-- along with this program. If not, see <https://www.gnu.org/licenses/>. 17-- along with this program. If not, see <https://www.gnu.org/licenses/>.
18 18
19module Resource 19module Resource
20 ( ItemProcessor, ThumbnailProcessor 20 ( ItemProcessor
21 , GalleryItem(..), GalleryItemProps(..), Resolution(..), Resource(..), Thumbnail(..) 21 , GalleryItem(..)
22 , buildGalleryTree, galleryCleanupResourceDir 22 , GalleryItemProps(..)
23 , Resolution(..)
24 , Resource(..)
25 , Thumbnail(..)
26 , buildGalleryTree
27 , galleryCleanupResourceDir
28 , flattenGalleryTree
23 ) where 29 ) where
24 30
25 31
@@ -29,15 +35,16 @@ import Data.List.Ordered (minusBy)
29import Data.Char (toLower) 35import Data.Char (toLower)
30import Data.Maybe (mapMaybe, fromMaybe) 36import Data.Maybe (mapMaybe, fromMaybe)
31import Data.Function ((&)) 37import Data.Function ((&))
38import Data.Functor ((<&>))
32import qualified Data.Set as Set 39import qualified Data.Set as Set
33import Data.Text (pack) 40import Data.Text (pack, unpack, breakOn)
34import Data.Time.Clock (UTCTime) 41import Data.Time.Clock (UTCTime)
35import Data.Time.LocalTime (ZonedTime, utc, utcToZonedTime, zonedTimeToUTC) 42import Data.Time.LocalTime (ZonedTime, utc, utcToZonedTime, zonedTimeToUTC)
36import Data.Time.Format (formatTime, defaultTimeLocale) 43import Data.Time.Format (formatTime, parseTimeM, defaultTimeLocale)
37import Safe.Foldable (maximumByMay) 44import Safe.Foldable (maximumByMay)
38 45
39import GHC.Generics (Generic) 46import GHC.Generics (Generic)
40import Data.Aeson (ToJSON, genericToJSON, genericToEncoding) 47import Data.Aeson (ToJSON, FromJSON, genericToJSON, genericToEncoding, genericParseJSON)
41import qualified Data.Aeson as JSON 48import qualified Data.Aeson as JSON
42 49
43import Files 50import Files
@@ -69,12 +76,23 @@ instance ToJSON Resource where
69 where 76 where
70 timestamp = formatTime defaultTimeLocale "%s" modTime 77 timestamp = formatTime defaultTimeLocale "%s" modTime
71 78
79instance FromJSON Resource where
80 parseJSON = JSON.withText "Resource" (unpackRes . breakOn "?")
81 where
82 unpackRes (resPathStr, modTimeStr) =
83 Resource (fromWebPath $ unpack resPathStr)
84 <$> parseTimeM True defaultTimeLocale "?%s" (unpack modTimeStr)
85
72 86
73data GalleryItemProps = 87data GalleryItemProps =
74 Directory { items :: [GalleryItem] } 88 Directory { items :: [GalleryItem] }
75 | Picture 89 | Picture
76 { resource :: Resource 90 { resource :: Resource
77 , resolution :: Resolution } 91 , resolution :: Resolution }
92 | PlainText { resource :: Resource }
93 | PDF { resource :: Resource }
94 | Video { resource :: Resource }
95 | Audio { resource :: Resource }
78 | Other { resource :: Resource } 96 | Other { resource :: Resource }
79 deriving (Generic, Show) 97 deriving (Generic, Show)
80 98
@@ -82,15 +100,14 @@ instance ToJSON GalleryItemProps where
82 toJSON = genericToJSON encodingOptions 100 toJSON = genericToJSON encodingOptions
83 toEncoding = genericToEncoding encodingOptions 101 toEncoding = genericToEncoding encodingOptions
84 102
103instance FromJSON GalleryItemProps where
104 parseJSON = genericParseJSON encodingOptions
105
85 106
86data Thumbnail = Thumbnail 107data Thumbnail = Thumbnail
87 { resource :: Resource 108 { resource :: Resource
88 , resolution :: Resolution 109 , resolution :: Resolution
89 } deriving (Generic, Show) 110 } deriving (Generic, Show, ToJSON, FromJSON)
90
91instance ToJSON Thumbnail where
92 toJSON = genericToJSON encodingOptions
93 toEncoding = genericToEncoding encodingOptions
94 111
95 112
96data GalleryItem = GalleryItem 113data GalleryItem = GalleryItem
@@ -101,49 +118,49 @@ data GalleryItem = GalleryItem
101 , path :: Path 118 , path :: Path
102 , thumbnail :: Maybe Thumbnail 119 , thumbnail :: Maybe Thumbnail
103 , properties :: GalleryItemProps 120 , properties :: GalleryItemProps
104 } deriving (Generic, Show) 121 } deriving (Generic, Show, ToJSON, FromJSON)
105
106instance ToJSON GalleryItem where
107 toJSON = genericToJSON encodingOptions
108 toEncoding = genericToEncoding encodingOptions
109 122
110 123
111type ItemProcessor = Path -> IO GalleryItemProps 124type ItemProcessor a =
112type ThumbnailProcessor = Path -> IO (Maybe Thumbnail) 125 Path -- Item path
126 -> Path -- Resource Path
127 -> IO a
113 128
114 129
115buildGalleryTree :: 130buildGalleryTree ::
116 ItemProcessor -> ThumbnailProcessor -> TagsFromDirectoriesConfig 131 ItemProcessor GalleryItemProps -> ItemProcessor (Maybe Thumbnail) -> TagsFromDirectoriesConfig
117 -> InputTree -> IO GalleryItem 132 -> InputTree -> IO GalleryItem
118buildGalleryTree processItem processThumbnail tagsFromDirsConfig inputTree = 133buildGalleryTree processItem processThumbnail tagsFromDirsConfig =
119 mkGalleryItem [] inputTree 134 mkGalleryItem []
120 where 135 where
121 mkGalleryItem :: [Tag] -> InputTree -> IO GalleryItem 136 mkGalleryItem :: [Tag] -> InputTree -> IO GalleryItem
122 mkGalleryItem inheritedTags InputFile{path, modTime, sidecar} = 137 mkGalleryItem inheritedTags InputFile{path, modTime, sidecar, thumbnailPath} =
123 do 138 do
124 properties <- processItem path 139 let itemPath = "/" /> path
125 processedThumbnail <- processThumbnail path 140 properties <- processItem itemPath path
141 processedThumbnail <- processThumbnail itemPath (thumbnailPath ?? path)
126 return GalleryItem 142 return GalleryItem
127 { title = Input.title sidecar ?? fileName path ?? "" 143 { title = Input.title sidecar ?? fileName path ?? ""
128 , datetime = Input.datetime sidecar ?? toZonedTime modTime 144 , datetime = Input.datetime sidecar ?? toZonedTime modTime
129 , description = Input.description sidecar ?? "" 145 , description = Input.description sidecar ?? ""
130 , tags = unique ((Input.tags sidecar ?? []) ++ inheritedTags ++ parentDirTags path) 146 , tags = unique ((Input.tags sidecar ?? []) ++ inheritedTags ++ parentDirTags path)
131 , path = "/" /> path 147 , path = itemPath
132 , thumbnail = processedThumbnail 148 , thumbnail = processedThumbnail
133 , properties = properties } 149 , properties = properties }
134 150
135 mkGalleryItem inheritedTags InputDir{path, modTime, sidecar, dirThumbnailPath, items} = 151 mkGalleryItem inheritedTags InputDir{path, modTime, sidecar, thumbnailPath, items} =
136 do 152 do
153 let itemPath = "/" /> path
137 let dirTags = (Input.tags sidecar ?? []) ++ inheritedTags 154 let dirTags = (Input.tags sidecar ?? []) ++ inheritedTags
138 processedItems <- parallel $ map (mkGalleryItem dirTags) items 155 processedItems <- parallel $ map (mkGalleryItem dirTags) items
139 processedThumbnail <- maybeThumbnail dirThumbnailPath 156 processedThumbnail <- maybeThumbnail itemPath thumbnailPath
140 return GalleryItem 157 return GalleryItem
141 { title = Input.title sidecar ?? fileName path ?? "" 158 { title = Input.title sidecar ?? fileName path ?? ""
142 , datetime = Input.datetime sidecar ?? mostRecentModTime processedItems 159 , datetime = Input.datetime sidecar ?? mostRecentModTime processedItems
143 ?? toZonedTime modTime 160 ?? toZonedTime modTime
144 , description = Input.description sidecar ?? "" 161 , description = Input.description sidecar ?? ""
145 , tags = unique (aggregateTags processedItems ++ parentDirTags path) 162 , tags = unique (aggregateTags processedItems ++ parentDirTags path)
146 , path = "/" /> path 163 , path = itemPath
147 , thumbnail = processedThumbnail 164 , thumbnail = processedThumbnail
148 , properties = Directory processedItems } 165 , properties = Directory processedItems }
149 166
@@ -163,9 +180,9 @@ buildGalleryTree processItem processThumbnail tagsFromDirsConfig inputTree =
163 aggregateTags :: [GalleryItem] -> [Tag] 180 aggregateTags :: [GalleryItem] -> [Tag]
164 aggregateTags = concatMap (\item -> tags (item::GalleryItem)) 181 aggregateTags = concatMap (\item -> tags (item::GalleryItem))
165 182
166 maybeThumbnail :: Maybe Path -> IO (Maybe Thumbnail) 183 maybeThumbnail :: Path -> Maybe Path -> IO (Maybe Thumbnail)
167 maybeThumbnail Nothing = return Nothing 184 maybeThumbnail _ Nothing = return Nothing
168 maybeThumbnail (Just thumbnailPath) = processThumbnail thumbnailPath 185 maybeThumbnail itemPath (Just thumbnailPath) = processThumbnail itemPath thumbnailPath
169 186
170 mostRecentModTime :: [GalleryItem] -> Maybe ZonedTime 187 mostRecentModTime :: [GalleryItem] -> Maybe ZonedTime
171 mostRecentModTime = 188 mostRecentModTime =
@@ -186,7 +203,7 @@ flattenGalleryTree simple = [simple]
186 203
187galleryOutputDiff :: GalleryItem -> FSNode -> [Path] 204galleryOutputDiff :: GalleryItem -> FSNode -> [Path]
188galleryOutputDiff resources ref = 205galleryOutputDiff resources ref =
189 (filesystemPaths ref) \\ (compiledPaths $ flattenGalleryTree resources) 206 filesystemPaths ref \\ compiledPaths (flattenGalleryTree resources)
190 where 207 where
191 filesystemPaths :: FSNode -> [Path] 208 filesystemPaths :: FSNode -> [Path]
192 filesystemPaths = map Files.path . tail . flattenDir 209 filesystemPaths = map Files.path . tail . flattenDir
@@ -208,8 +225,7 @@ galleryOutputDiff resources ref =
208 225
209 thumbnailPaths :: [GalleryItem] -> [Path] 226 thumbnailPaths :: [GalleryItem] -> [Path]
210 thumbnailPaths = 227 thumbnailPaths =
211 map resourcePath 228 map (resourcePath . (resource :: (Thumbnail -> Resource)))
212 . map (resource :: (Thumbnail -> Resource))
213 . mapMaybe thumbnail 229 . mapMaybe thumbnail
214 230
215 (\\) :: [Path] -> [Path] -> [Path] 231 (\\) :: [Path] -> [Path] -> [Path]
@@ -231,7 +247,7 @@ galleryOutputDiff resources ref =
231galleryCleanupResourceDir :: GalleryItem -> FileName -> IO () 247galleryCleanupResourceDir :: GalleryItem -> FileName -> IO ()
232galleryCleanupResourceDir resourceTree outputDir = 248galleryCleanupResourceDir resourceTree outputDir =
233 readDirectory outputDir 249 readDirectory outputDir
234 >>= return . galleryOutputDiff resourceTree . root 250 <&> galleryOutputDiff resourceTree . root
235 >>= return . sortOn ((0 -) . pathLength) -- nested files before their parent dirs 251 <&> sortOn ((0 -) . pathLength) -- nested files before their parent dirs
236 >>= return . map (localPath . (/>) outputDir) 252 <&> map (localPath . (/>) outputDir)
237 >>= mapM_ remove 253 >>= mapM_ remove