From 04d5cb917f4288c26a308dfda4ba788d77fda8fd Mon Sep 17 00:00:00 2001 From: pacien Date: Wed, 13 May 2020 00:18:16 +0200 Subject: compiler: add plain text file format support through simple copy --- compiler/src/Resource.hs | 1 + 1 file changed, 1 insertion(+) (limited to 'compiler/src/Resource.hs') diff --git a/compiler/src/Resource.hs b/compiler/src/Resource.hs index e134468..5c175f1 100644 --- a/compiler/src/Resource.hs +++ b/compiler/src/Resource.hs @@ -75,6 +75,7 @@ data GalleryItemProps = | Picture { resource :: Resource , resolution :: Resolution } + | PlainText { resource :: Resource } | Other { resource :: Resource } deriving (Generic, Show) -- cgit v1.2.3 From e9e46a3b3392ab435f7414729592b2b5af4071b6 Mon Sep 17 00:00:00 2001 From: pacien Date: Mon, 18 May 2020 20:05:14 +0200 Subject: compiler: add pdf resource type --- compiler/src/Resource.hs | 1 + 1 file changed, 1 insertion(+) (limited to 'compiler/src/Resource.hs') diff --git a/compiler/src/Resource.hs b/compiler/src/Resource.hs index 5c175f1..129a817 100644 --- a/compiler/src/Resource.hs +++ b/compiler/src/Resource.hs @@ -76,6 +76,7 @@ data GalleryItemProps = { resource :: Resource , resolution :: Resolution } | PlainText { resource :: Resource } + | PDF { resource :: Resource } | Other { resource :: Resource } deriving (Generic, Show) -- cgit v1.2.3 From 516ee7c5599f2c90a636fd9301806bef67830046 Mon Sep 17 00:00:00 2001 From: pacien Date: Tue, 19 May 2020 21:06:16 +0200 Subject: compiler: add audio and video extensions --- compiler/src/Resource.hs | 2 ++ 1 file changed, 2 insertions(+) (limited to 'compiler/src/Resource.hs') diff --git a/compiler/src/Resource.hs b/compiler/src/Resource.hs index 129a817..c08677d 100644 --- a/compiler/src/Resource.hs +++ b/compiler/src/Resource.hs @@ -77,6 +77,8 @@ data GalleryItemProps = , resolution :: Resolution } | PlainText { resource :: Resource } | PDF { resource :: Resource } + | Video { resource :: Resource } + | Audio { resource :: Resource } | Other { resource :: Resource } deriving (Generic, Show) -- cgit v1.2.3 From 00c6216259d8a7b131307953ba5000d2b5dc564b Mon Sep 17 00:00:00 2001 From: pacien Date: Sat, 13 Jun 2020 00:06:18 +0200 Subject: compiler: trivial code simplifications Following HLint's advice. --- compiler/src/Resource.hs | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) (limited to 'compiler/src/Resource.hs') diff --git a/compiler/src/Resource.hs b/compiler/src/Resource.hs index c08677d..607c7f6 100644 --- a/compiler/src/Resource.hs +++ b/compiler/src/Resource.hs @@ -29,6 +29,7 @@ import Data.List.Ordered (minusBy) import Data.Char (toLower) import Data.Maybe (mapMaybe, fromMaybe) import Data.Function ((&)) +import Data.Functor ((<&>)) import qualified Data.Set as Set import Data.Text (pack) import Data.Time.Clock (UTCTime) @@ -119,8 +120,8 @@ type ThumbnailProcessor = Path -> IO (Maybe Thumbnail) buildGalleryTree :: ItemProcessor -> ThumbnailProcessor -> TagsFromDirectoriesConfig -> InputTree -> IO GalleryItem -buildGalleryTree processItem processThumbnail tagsFromDirsConfig inputTree = - mkGalleryItem [] inputTree +buildGalleryTree processItem processThumbnail tagsFromDirsConfig = + mkGalleryItem [] where mkGalleryItem :: [Tag] -> InputTree -> IO GalleryItem mkGalleryItem inheritedTags InputFile{path, modTime, sidecar} = @@ -190,7 +191,7 @@ flattenGalleryTree simple = [simple] galleryOutputDiff :: GalleryItem -> FSNode -> [Path] galleryOutputDiff resources ref = - (filesystemPaths ref) \\ (compiledPaths $ flattenGalleryTree resources) + filesystemPaths ref \\ compiledPaths (flattenGalleryTree resources) where filesystemPaths :: FSNode -> [Path] filesystemPaths = map Files.path . tail . flattenDir @@ -212,8 +213,7 @@ galleryOutputDiff resources ref = thumbnailPaths :: [GalleryItem] -> [Path] thumbnailPaths = - map resourcePath - . map (resource :: (Thumbnail -> Resource)) + map (resourcePath . (resource :: (Thumbnail -> Resource))) . mapMaybe thumbnail (\\) :: [Path] -> [Path] -> [Path] @@ -235,7 +235,7 @@ galleryOutputDiff resources ref = galleryCleanupResourceDir :: GalleryItem -> FileName -> IO () galleryCleanupResourceDir resourceTree outputDir = readDirectory outputDir - >>= return . galleryOutputDiff resourceTree . root - >>= return . sortOn ((0 -) . pathLength) -- nested files before their parent dirs - >>= return . map (localPath . (/>) outputDir) + <&> galleryOutputDiff resourceTree . root + <&> sortOn ((0 -) . pathLength) -- nested files before their parent dirs + <&> map (localPath . (/>) outputDir) >>= mapM_ remove -- cgit v1.2.3 From ce2210e6deff1d981186b6d7ddb1176f27e41f49 Mon Sep 17 00:00:00 2001 From: pacien Date: Sat, 13 Jun 2020 03:41:39 +0200 Subject: compiler: make GalleryIndex loadable from JSON --- compiler/src/Resource.hs | 28 +++++++++++++++------------- 1 file changed, 15 insertions(+), 13 deletions(-) (limited to 'compiler/src/Resource.hs') diff --git a/compiler/src/Resource.hs b/compiler/src/Resource.hs index 607c7f6..fa139e0 100644 --- a/compiler/src/Resource.hs +++ b/compiler/src/Resource.hs @@ -31,14 +31,14 @@ import Data.Maybe (mapMaybe, fromMaybe) import Data.Function ((&)) import Data.Functor ((<&>)) import qualified Data.Set as Set -import Data.Text (pack) +import Data.Text (pack, unpack, breakOn) import Data.Time.Clock (UTCTime) import Data.Time.LocalTime (ZonedTime, utc, utcToZonedTime, zonedTimeToUTC) -import Data.Time.Format (formatTime, defaultTimeLocale) +import Data.Time.Format (formatTime, parseTimeM, defaultTimeLocale) import Safe.Foldable (maximumByMay) import GHC.Generics (Generic) -import Data.Aeson (ToJSON, genericToJSON, genericToEncoding) +import Data.Aeson (ToJSON, FromJSON, genericToJSON, genericToEncoding, genericParseJSON) import qualified Data.Aeson as JSON import Files @@ -70,6 +70,13 @@ instance ToJSON Resource where where timestamp = formatTime defaultTimeLocale "%s" modTime +instance FromJSON Resource where + parseJSON = JSON.withText "Resource" (unpackRes . breakOn "?") + where + unpackRes (resPathStr, modTimeStr) = + Resource (fromWebPath $ unpack resPathStr) + <$> parseTimeM True defaultTimeLocale "?%s" (unpack modTimeStr) + data GalleryItemProps = Directory { items :: [GalleryItem] } @@ -87,15 +94,14 @@ instance ToJSON GalleryItemProps where toJSON = genericToJSON encodingOptions toEncoding = genericToEncoding encodingOptions +instance FromJSON GalleryItemProps where + parseJSON = genericParseJSON encodingOptions + data Thumbnail = Thumbnail { resource :: Resource , resolution :: Resolution - } deriving (Generic, Show) - -instance ToJSON Thumbnail where - toJSON = genericToJSON encodingOptions - toEncoding = genericToEncoding encodingOptions + } deriving (Generic, Show, ToJSON, FromJSON) data GalleryItem = GalleryItem @@ -106,11 +112,7 @@ data GalleryItem = GalleryItem , path :: Path , thumbnail :: Maybe Thumbnail , properties :: GalleryItemProps - } deriving (Generic, Show) - -instance ToJSON GalleryItem where - toJSON = genericToJSON encodingOptions - toEncoding = genericToEncoding encodingOptions + } deriving (Generic, Show, ToJSON, FromJSON) type ItemProcessor = Path -> IO GalleryItemProps -- cgit v1.2.3 From 52abb806a3bde6eb69d64564d971efae2cbfda24 Mon Sep 17 00:00:00 2001 From: pacien Date: Mon, 15 Jun 2020 04:46:11 +0200 Subject: compiler: reuse derived item properties from last compilation A benchmark on an already bulit gallery with ~600 pictures shows a ~90% speedup: Before: Time (mean ± σ): 2.879 s ± 0.125 s [User: 14.686 s, System: 5.511 s] Range (min … max): 2.774 s … 3.203 s 10 runs After: Time (mean ± σ): 289.5 ms ± 15.1 ms [User: 596.1 ms, System: 359.3 ms] Range (min … max): 272.8 ms … 323.0 ms 10 runs GitHub: closes #97 --- compiler/src/Resource.hs | 38 ++++++++++++++++++++++++-------------- 1 file changed, 24 insertions(+), 14 deletions(-) (limited to 'compiler/src/Resource.hs') diff --git a/compiler/src/Resource.hs b/compiler/src/Resource.hs index fa139e0..6b4b44c 100644 --- a/compiler/src/Resource.hs +++ b/compiler/src/Resource.hs @@ -17,9 +17,15 @@ -- along with this program. If not, see . module Resource - ( ItemProcessor, ThumbnailProcessor - , GalleryItem(..), GalleryItemProps(..), Resolution(..), Resource(..), Thumbnail(..) - , buildGalleryTree, galleryCleanupResourceDir + ( ItemProcessor + , GalleryItem(..) + , GalleryItemProps(..) + , Resolution(..) + , Resource(..) + , Thumbnail(..) + , buildGalleryTree + , galleryCleanupResourceDir + , flattenGalleryTree ) where @@ -115,12 +121,14 @@ data GalleryItem = GalleryItem } deriving (Generic, Show, ToJSON, FromJSON) -type ItemProcessor = Path -> IO GalleryItemProps -type ThumbnailProcessor = Path -> IO (Maybe Thumbnail) +type ItemProcessor a = + Path -- Item path + -> Path -- Resource Path + -> IO a buildGalleryTree :: - ItemProcessor -> ThumbnailProcessor -> TagsFromDirectoriesConfig + ItemProcessor GalleryItemProps -> ItemProcessor (Maybe Thumbnail) -> TagsFromDirectoriesConfig -> InputTree -> IO GalleryItem buildGalleryTree processItem processThumbnail tagsFromDirsConfig = mkGalleryItem [] @@ -128,29 +136,31 @@ buildGalleryTree processItem processThumbnail tagsFromDirsConfig = mkGalleryItem :: [Tag] -> InputTree -> IO GalleryItem mkGalleryItem inheritedTags InputFile{path, modTime, sidecar} = do - properties <- processItem path - processedThumbnail <- processThumbnail path + let itemPath = "/" /> path + properties <- processItem itemPath path + processedThumbnail <- processThumbnail itemPath path return GalleryItem { title = Input.title sidecar ?? fileName path ?? "" , datetime = Input.datetime sidecar ?? toZonedTime modTime , description = Input.description sidecar ?? "" , tags = unique ((Input.tags sidecar ?? []) ++ inheritedTags ++ parentDirTags path) - , path = "/" /> path + , path = itemPath , thumbnail = processedThumbnail , properties = properties } mkGalleryItem inheritedTags InputDir{path, modTime, sidecar, dirThumbnailPath, items} = do + let itemPath = "/" /> path let dirTags = (Input.tags sidecar ?? []) ++ inheritedTags processedItems <- parallel $ map (mkGalleryItem dirTags) items - processedThumbnail <- maybeThumbnail dirThumbnailPath + processedThumbnail <- maybeThumbnail itemPath dirThumbnailPath return GalleryItem { title = Input.title sidecar ?? fileName path ?? "" , datetime = Input.datetime sidecar ?? mostRecentModTime processedItems ?? toZonedTime modTime , description = Input.description sidecar ?? "" , tags = unique (aggregateTags processedItems ++ parentDirTags path) - , path = "/" /> path + , path = itemPath , thumbnail = processedThumbnail , properties = Directory processedItems } @@ -170,9 +180,9 @@ buildGalleryTree processItem processThumbnail tagsFromDirsConfig = aggregateTags :: [GalleryItem] -> [Tag] aggregateTags = concatMap (\item -> tags (item::GalleryItem)) - maybeThumbnail :: Maybe Path -> IO (Maybe Thumbnail) - maybeThumbnail Nothing = return Nothing - maybeThumbnail (Just thumbnailPath) = processThumbnail thumbnailPath + maybeThumbnail :: Path -> Maybe Path -> IO (Maybe Thumbnail) + maybeThumbnail _ Nothing = return Nothing + maybeThumbnail itemPath (Just thumbnailPath) = processThumbnail itemPath thumbnailPath mostRecentModTime :: [GalleryItem] -> Maybe ZonedTime mostRecentModTime = -- cgit v1.2.3 From e27f9a220fd8597266d52934bcb06dbe1681b338 Mon Sep 17 00:00:00 2001 From: pacien Date: Tue, 16 Jun 2020 23:30:32 +0200 Subject: compiler: allow setting thumbnails for all items Not only for directories. GitHub: closes #224 --- compiler/src/Resource.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) (limited to 'compiler/src/Resource.hs') diff --git a/compiler/src/Resource.hs b/compiler/src/Resource.hs index 6b4b44c..f59eed6 100644 --- a/compiler/src/Resource.hs +++ b/compiler/src/Resource.hs @@ -134,11 +134,11 @@ buildGalleryTree processItem processThumbnail tagsFromDirsConfig = mkGalleryItem [] where mkGalleryItem :: [Tag] -> InputTree -> IO GalleryItem - mkGalleryItem inheritedTags InputFile{path, modTime, sidecar} = + mkGalleryItem inheritedTags InputFile{path, modTime, sidecar, thumbnailPath} = do let itemPath = "/" /> path properties <- processItem itemPath path - processedThumbnail <- processThumbnail itemPath path + processedThumbnail <- processThumbnail itemPath (thumbnailPath ?? path) return GalleryItem { title = Input.title sidecar ?? fileName path ?? "" , datetime = Input.datetime sidecar ?? toZonedTime modTime @@ -148,12 +148,12 @@ buildGalleryTree processItem processThumbnail tagsFromDirsConfig = , thumbnail = processedThumbnail , properties = properties } - mkGalleryItem inheritedTags InputDir{path, modTime, sidecar, dirThumbnailPath, items} = + mkGalleryItem inheritedTags InputDir{path, modTime, sidecar, thumbnailPath, items} = do let itemPath = "/" /> path let dirTags = (Input.tags sidecar ?? []) ++ inheritedTags processedItems <- parallel $ map (mkGalleryItem dirTags) items - processedThumbnail <- maybeThumbnail itemPath dirThumbnailPath + processedThumbnail <- maybeThumbnail itemPath thumbnailPath return GalleryItem { title = Input.title sidecar ?? fileName path ?? "" , datetime = Input.datetime sidecar ?? mostRecentModTime processedItems -- cgit v1.2.3