6 files changed, 53 insertions, 30 deletions

diff --git a/compiler/src/Caching.hs b/compiler/src/Caching.hs
index c2b5a43..1a8b710 100644
--- a/compiler/src/Caching.hs
+++ b/compiler/src/Caching.hs
@@ -53,7 +53,7 @@ buildItemCache cachedItems = lookupCache
     cachedMap = Map.fromList (map withKey cachedItemList)
     lookupCache path = Map.lookup (webPath path) cachedMap
 
-useCached :: ItemCache -> (GalleryItem -> a) -> Cache a
+useCached :: ItemCache -> (GalleryItem -> Maybe a) -> Cache a
 useCached cache propGetter processor itemPath resPath inputFsPath outputFsPath =
   do
     isDir <- doesDirectoryExist outputFsPath
@@ -63,7 +63,7 @@ useCached cache propGetter processor itemPath resPath inputFsPath outputFsPath =
     if fileExists then
       do
         needUpdate <- isOutdated True inputFsPath outputFsPath
-        case (needUpdate, cache itemPath) of
+        case (needUpdate, cache itemPath >>= propGetter) of
           (False, Just props) -> fromCache props
           _ -> update
     else
@@ -73,4 +73,4 @@ useCached cache propGetter processor itemPath resPath inputFsPath outputFsPath =
     update = processor itemPath resPath inputFsPath outputFsPath
     fromCache props =
       putStrLn ("From cache:\t" ++ outputFsPath)
-      >> return (propGetter props)
+      >> return props
diff --git a/compiler/src/Compiler.hs b/compiler/src/Compiler.hs
index 1ec55c5..d92d8e9 100644
--- a/compiler/src/Compiler.hs
+++ b/compiler/src/Compiler.hs
@@ -85,7 +85,8 @@ loadGalleryIndex path =
   doesFileExist path >>= bool (return Nothing) decodeIndex
   where
     decodeIndex =
-      JSON.eitherDecodeFileStrict path
+      putStrLn ("Loading previous index:\t" ++ path)
+      >>  JSON.eitherDecodeFileStrict path
       >>= either (\err -> warn err >> return Nothing) (return . Just)
     warn = putStrLn . ("Warning:\tUnable to reuse existing index as cache: " ++)
 
@@ -136,10 +137,13 @@ compileGallery configPath inputDirPath outputDirPath outputIndexPath excludedDir
   do
     config <- readConfig $ inputGalleryConf configPath
 
+    putStrLn "Inventorying input files"
     inputDir <- readDirectory inputDirPath
     excludedCanonicalDirs <- mapM canonicalizePath excludedDirs
+
     let sourceFilter = galleryDirFilter config excludedCanonicalDirs
     let sourceTree = filterDir sourceFilter inputDir
+    putStrLn "Reading input metadata"
     inputTree <- readInputTree sourceTree
     let curatedInputTree = filterInputTree (inputTreeFilter config) inputTree
 
@@ -147,8 +151,8 @@ compileGallery configPath inputDirPath outputDirPath outputIndexPath excludedDir
     cachedIndex <- loadCachedIndex galleryIndexPath
     let cache = mkCache cachedIndex
 
-    let itemProc = itemProcessor config (cache Resource.properties)
-    let thumbnailProc = thumbnailProcessor config (cache Resource.thumbnail)
+    let itemProc = itemProcessor config (cache $ return . Resource.properties)
+    let thumbnailProc = thumbnailProcessor config (cache $ fmap return . Resource.thumbnail)
     let galleryBuilder = buildGalleryTree itemProc thumbnailProc (tagsFromDirectories config)
     resources <- galleryBuilder curatedInputTree
 
@@ -170,7 +174,7 @@ compileGallery configPath inputDirPath outputDirPath outputIndexPath excludedDir
         then return Nothing
         else loadGalleryIndex galleryIndexPath
 
-    mkCache :: Maybe GalleryIndex -> (GalleryItem -> a) -> Cache a
+    mkCache :: Maybe GalleryIndex -> (GalleryItem -> Maybe a) -> Cache a
     mkCache refGalleryIndex =
       if rebuildAll
         then const noCache
diff --git a/compiler/src/FileProcessors.hs b/compiler/src/FileProcessors.hs
index 5c4e1c8..78e7351 100644
--- a/compiler/src/FileProcessors.hs
+++ b/compiler/src/FileProcessors.hs
@@ -1,7 +1,7 @@
 -- ldgallery - A static generator which turns a collection of tagged
 --             pictures into a searchable web gallery.
 --
--- Copyright (C) 2019-2020  Pacien TRAN-GIRARD
+-- Copyright (C) 2019-2022  Pacien TRAN-GIRARD
 --
 -- This program is free software: you can redistribute it and/or modify
 -- it under the terms of the GNU Affero General Public License as
@@ -79,7 +79,7 @@ copyFileProcessor inputPath outputPath =
 
 resizePictureUpTo :: Resolution -> FileTransformer
 resizePictureUpTo maxResolution inputPath outputPath =
-  putStrLn ("Generating:\t" ++ outputPath)
+  putStrLn ("Processing:\t" ++ outputPath)
   >> ensureParentDir (flip resize) outputPath inputPath
   where
     maxSize :: Resolution -> String
@@ -100,17 +100,35 @@ type FileDescriber a =
 
 getImageResolution :: FilePath -> IO Resolution
 getImageResolution fsPath =
-  readProcess "magick" ["identify", "-format", "%w %h", firstFrame] []
-  >>= parseResolution . break (== ' ')
+  readProcess "magick"
+    [ "identify"
+    , "-ping"
+    , "-format", "%[orientation] %w %h"
+    , firstFrame
+    ] []
+  >>= parseOutput . words
+
   where
     firstFrame :: FilePath
     firstFrame = fsPath ++ "[0]"
 
+    -- Flip the dimensions when necessary according to the metadata.
+    -- ImageMagick's `-auto-orient` flag does the same, but isn't compatible
+    -- with `-ping` and causes the whole image file to be loaded.
+    parseOutput :: [String] -> IO Resolution
+    parseOutput ["RightTop", w, h] = parseResolution (h, w)
+    parseOutput ["LeftBottom", w, h] = parseResolution (h, w)
+    parseOutput [_, w, h] = parseResolution (w, h)
+    parseOutput _ = throwIO failedRead
+
     parseResolution :: (String, String) -> IO Resolution
     parseResolution (widthString, heightString) =
       case (readMaybe widthString, readMaybe heightString) of
         (Just w, Just h) -> return $ Resolution w h
-        _ -> throwIO $ ProcessingException fsPath "Unable to read image resolution."
+        _ -> throwIO failedRead
+
+    failedRead :: ProcessingException
+    failedRead = ProcessingException fsPath "Unable to read image resolution."
 
 resourceAt :: FileDescriber Resource
 resourceAt resPath fsPath = Resource resPath <$> getModificationTime fsPath
diff --git a/compiler/src/Input.hs b/compiler/src/Input.hs
index 48931ec..7990571 100644
--- a/compiler/src/Input.hs
+++ b/compiler/src/Input.hs
@@ -1,7 +1,7 @@
 -- ldgallery - A static generator which turns a collection of tagged
 --             pictures into a searchable web gallery.
 --
--- Copyright (C) 2019-2020  Pacien TRAN-GIRARD
+-- Copyright (C) 2019-2022  Pacien TRAN-GIRARD
 --
 -- This program is free software: you can redistribute it and/or modify
 -- it under the terms of the GNU Affero General Public License as
@@ -100,9 +100,7 @@ readSidecarFile filepath =
 
 
 readInputTree :: AnchoredFSNode -> IO InputTree
-readInputTree (AnchoredFSNode _ File{}) =
-  throw $ AssertionFailed "Input directory is a file"
-readInputTree (AnchoredFSNode anchor root@Dir{}) = mkDirNode root
+readInputTree (AnchoredFSNode anchor root) = mkDirNode root
   where
     mkInputNode :: Map.Map FileName FSNode -> FSNode -> IO (Maybe InputTree)
     mkInputNode dir file@File{path} | not (isSidecar file) && not (isThumbnail file) =
@@ -155,6 +153,4 @@ filterInputTree cond = filterNode
     filterNode :: InputTree -> InputTree
     filterNode inputFile@InputFile{} = inputFile
     filterNode inputDir@InputDir{items} =
-        filter cond items
-      & map filterNode
-      & \curatedItems -> inputDir { items = curatedItems } :: InputTree
+      inputDir { Input.items = filter cond items & map filterNode }
diff --git a/compiler/src/ItemProcessors.hs b/compiler/src/ItemProcessors.hs
index f967954..6035477 100644
--- a/compiler/src/ItemProcessors.hs
+++ b/compiler/src/ItemProcessors.hs
@@ -1,7 +1,7 @@
 -- ldgallery - A static generator which turns a collection of tagged
 --             pictures into a searchable web gallery.
 --
--- Copyright (C) 2019-2020  Pacien TRAN-GIRARD
+-- Copyright (C) 2019-2022  Pacien TRAN-GIRARD
 --
 -- This program is free software: you can redistribute it and/or modify
 -- it under the terms of the GNU Affero General Public License as
@@ -36,7 +36,9 @@ import Files
 data Format =
     PictureFormat
   | PlainTextFormat
+  | MarkdownFormat
   | PortableDocumentFormat
+  | EPUBFormat
   | VideoFormat
   | AudioFormat
   | Unknown
@@ -54,9 +56,11 @@ formatFromPath =
       ".tiff" -> PictureFormat
       ".hdr" -> PictureFormat
       ".gif" -> PictureFormat
+      ".webp" -> PictureFormat
       ".txt" -> PlainTextFormat