From 9dd271504160b624284dbc438cdc867b6ca0d0e7 Mon Sep 17 00:00:00 2001 From: pacien Date: Sun, 5 Jan 2020 16:24:02 +0100 Subject: compiler: enable warnings and fix them GitHub: fixes #9 --- compiler/src/Compiler.hs | 14 ++++++++++++-- compiler/src/Config.hs | 5 ++--- compiler/src/Files.hs | 5 +++-- compiler/src/Input.hs | 9 ++++++--- compiler/src/Processors.hs | 17 +++++++++-------- compiler/src/Resource.hs | 8 ++------ 6 files changed, 34 insertions(+), 24 deletions(-) (limited to 'compiler/src') diff --git a/compiler/src/Compiler.hs b/compiler/src/Compiler.hs index 5d30a26..f4b38d0 100644 --- a/compiler/src/Compiler.hs +++ b/compiler/src/Compiler.hs @@ -29,7 +29,6 @@ module Compiler import Control.Monad (liftM2) -import Data.Function ((&)) import Data.List (any) import Data.Maybe (isJust, fromMaybe) import Text.Regex (Regex, mkRegex, matchRegex) @@ -39,7 +38,7 @@ import Data.Aeson (ToJSON) import qualified Data.Aeson as JSON import Config -import Input (decodeYamlFile, readInputTree) +import Input (readInputTree) import Resource (buildGalleryTree, galleryCleanupResourceDir) import Files ( FileName @@ -55,11 +54,22 @@ import Processors , skipCached, withCached ) +galleryConf :: String galleryConf = "gallery.yaml" + +indexFile :: String indexFile = "index.json" + +viewerMainFile :: String viewerMainFile = "index.html" + +viewerConfFile :: String viewerConfFile = "viewer.json" + +itemsDir :: String itemsDir = "items" + +thumbnailsDir :: String thumbnailsDir = "thumbnails" diff --git a/compiler/src/Config.hs b/compiler/src/Config.hs index 9bb2860..c6d77af 100644 --- a/compiler/src/Config.hs +++ b/compiler/src/Config.hs @@ -1,7 +1,7 @@ -- ldgallery - A static generator which turns a collection of tagged -- pictures into a searchable web gallery. -- --- Copyright (C) 2019 Pacien TRAN-GIRARD +-- Copyright (C) 2019-2020 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 @@ -30,9 +30,8 @@ module Config ) where -import Data.Text (Text) import GHC.Generics (Generic) -import Data.Aeson (ToJSON, FromJSON, withObject, (.:?), (.!=)) +import Data.Aeson (FromJSON, withObject, (.:?), (.!=)) import qualified Data.Aeson as JSON import Files (FileName) diff --git a/compiler/src/Files.hs b/compiler/src/Files.hs index 53f9c9e..291a1c5 100644 --- a/compiler/src/Files.hs +++ b/compiler/src/Files.hs @@ -34,9 +34,9 @@ module Files ) where -import Control.Monad (filterM, mapM) +import Control.Monad (mapM) import Data.Bool (bool) -import Data.List (isPrefixOf, length, deleteBy, subsequences) +import Data.List (isPrefixOf, length, subsequences) import Data.Function ((&)) import Data.Text (pack) import Data.Aeson (ToJSON) @@ -80,6 +80,7 @@ file /> (Path path) = Path (path ++ [file]) (<.>) :: Path -> String -> Path (Path (filename:pathto)) <.> ext = Path $ System.FilePath.addExtension filename ext : pathto +(Path _) <.> ext = Path [ext] fileName :: Path -> Maybe FileName fileName (Path (name:_)) = Just name diff --git a/compiler/src/Input.hs b/compiler/src/Input.hs index 7e1b169..ab2bc3c 100644 --- a/compiler/src/Input.hs +++ b/compiler/src/Input.hs @@ -31,10 +31,10 @@ module Input import GHC.Generics (Generic) -import Control.Exception (Exception, throwIO) +import Control.Exception (Exception, AssertionFailed(..), throw, throwIO) import Control.Monad.IO.Class (MonadIO, liftIO) import Data.Function ((&)) -import Data.Maybe (mapMaybe, catMaybes) +import Data.Maybe (catMaybes) import Data.Bool (bool) import Data.List (find) import Data.Yaml (ParseException, decodeFileEither) @@ -90,6 +90,8 @@ readSidecarFile filepath = readInputTree :: AnchoredFSNode -> IO InputTree +readInputTree (AnchoredFSNode _ File{}) = + throw $ AssertionFailed "Input directory is a file" readInputTree (AnchoredFSNode anchor root@Dir{}) = mkDirNode root where mkInputNode :: FSNode -> IO (Maybe InputTree) @@ -101,7 +103,8 @@ readInputTree (AnchoredFSNode anchor root@Dir{}) = mkDirNode root mkInputNode dir@Dir{} = mkDirNode dir >>= return . Just mkDirNode :: FSNode -> IO InputTree - mkDirNode (Dir path items) = + mkDirNode File{} = throw $ AssertionFailed "Input directory is a file" + mkDirNode Dir{path, items} = mapM mkInputNode items >>= return . catMaybes >>= return . InputDir path (findThumbnail items) diff --git a/compiler/src/Processors.hs b/compiler/src/Processors.hs index 2525af4..6ee8c78 100644 --- a/compiler/src/Processors.hs +++ b/compiler/src/Processors.hs @@ -32,7 +32,7 @@ module Processors ) where -import Control.Exception (Exception, throwIO) +import Control.Exception (Exception, PatternMatchFail(..), throw, throwIO) import Data.Function ((&)) import Data.Ratio ((%)) import Data.Char (toLower) @@ -90,12 +90,13 @@ resizeStaticImageUpTo Jpg = resizeStaticGeneric readJpeg (saveJpgImage 80) resizeStaticImageUpTo Png = resizeStaticGeneric readPng savePngImage resizeStaticImageUpTo Tiff = resizeStaticGeneric readTiff saveTiffImage resizeStaticImageUpTo Hdr = resizeStaticGeneric readHDR saveRadianceImage -resizeStaticImageUpTo Gif = resizeStaticGeneric readGif writeGifImage +resizeStaticImageUpTo Gif = resizeStaticGeneric readGif saveGifImage' where - writeGifImage :: StaticImageWriter - writeGifImage outputPath image = + saveGifImage' :: StaticImageWriter + saveGifImage' outputPath image = saveGifImage outputPath image & either (throwIO . ProcessingException outputPath) id +resizeStaticImageUpTo _ = throw $ PatternMatchFail "Unhandled format" type StaticImageReader = FilePath -> IO (Either String DynamicImage) @@ -166,14 +167,14 @@ type ItemFileProcessor = -> ItemProcessor itemFileProcessor :: Maybe Resolution -> Cache -> ItemFileProcessor -itemFileProcessor maxRes cached inputBase outputBase resClass inputRes = +itemFileProcessor maxResolution cached inputBase outputBase resClass inputRes = cached processor inPath outPath >> return (relOutPath, props) where relOutPath = resClass /> inputRes inPath = localPath $ inputBase /> inputRes outPath = localPath $ outputBase /> relOutPath - (processor, props) = formatProcessor maxRes $ formatFromPath inputRes + (processor, props) = formatProcessor maxResolution $ formatFromPath inputRes formatProcessor :: Maybe Resolution -> Format -> (FileProcessor, GalleryItemProps) formatProcessor Nothing _ = (copyFileProcessor, Other) @@ -203,8 +204,8 @@ thumbnailFileProcessor maxRes cached inputBase outputBase resClass inputRes = process :: Maybe FileProcessor -> IO (Maybe Path) process Nothing = return Nothing - process (Just processor) = - processor inPath outPath + process (Just proc) = + proc inPath outPath >> return (Just relOutPath) processor :: Format -> Maybe FileProcessor diff --git a/compiler/src/Resource.hs b/compiler/src/Resource.hs index b52522c..c09b77a 100644 --- a/compiler/src/Resource.hs +++ b/compiler/src/Resource.hs @@ -31,8 +31,7 @@ module Resource import Control.Concurrent.ParallelIO.Global (parallel) -import Data.Function ((&)) -import Data.List ((\\), subsequences, sortBy) +import Data.List ((\\), sortBy) import Data.Ord (comparing) import Data.Char (toLower) import Data.Maybe (mapMaybe, fromMaybe) @@ -57,10 +56,7 @@ encodingOptions = JSON.defaultOptions } - type Tag = String -type FileSizeKB = Int - data Resolution = Resolution { width :: Int @@ -147,7 +143,7 @@ buildGalleryTree processDir processItem processThumbnail addDirTag galleryName i where maybeThumbnail :: Maybe Path -> IO (Maybe Path) maybeThumbnail Nothing = return Nothing - maybeThumbnail (Just path) = processThumbnail path + maybeThumbnail (Just thumbnailPath) = processThumbnail thumbnailPath aggregateChildTags :: [GalleryItem] -> [Tag] aggregateChildTags = unique . concatMap (\item -> tags (item::GalleryItem)) -- cgit v1.2.3