rhi
/
gallery
1
0
Fork 0
Code Issues 5 Pull Requests 1 Releases Wiki Activity

make #thumb smarter

This commit is contained in:
Rhiannon Morris 2020-07-15 20:07:51 +02:00
parent 849d893b86
commit d360121efd
2 changed files with 15 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
make-pages/Depend.hs
View File

@ -26,10 +26,7 @@ dependSingle' yaml info build nsfw =
thumbnail :: Info -> FilePath
thumbnail (Info {thumb = Just t}) = t
thumbnail (Info {images})
| Just i <- find #sfw images = #path i
| otherwise = error "no thumbnail or sfw images"
thumbnail = fromMaybe (error "no thumbnail or sfw images") . #thumb
addSuffix :: String -> FilePath -> FilePath
addSuffix suf path =

20
make-pages/Info.hs
View File

@ -7,13 +7,15 @@ where
import Records
import Data.YAML (FromYAML (..), (.:), (.:?), (.!=))
import qualified Data.YAML as YAML
import Data.Time.Calendar (Day (..))
import Control.Applicative
import Data.Foldable (find)
import qualified Data.Map.Strict as Map
import Data.Maybe (isJust, isNothing)
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Map.Strict as Map
import Control.Applicative
import Data.Time.Calendar (Day (..))
import Data.YAML (FromYAML (..), (.:), (.:?), (.!=))
import qualified Data.YAML as YAML
import Text.Read (readMaybe)
@ -27,7 +29,7 @@ data Info =
nsfwTags :: ![Text],
description :: !(Maybe Text),
images :: ![Image],
thumb :: !(Maybe FilePath),
thumb' :: !(Maybe FilePath),
links :: ![Link]
}
deriving (Eq, Show)
@ -60,6 +62,12 @@ instance HasField "sfw" Info Bool where getField = not . #nsfw
instance HasField "sfw" Image Bool where getField = not . #nsfw
instance HasField "sfw" Link Bool where getField = not . #nsfw
instance HasField "thumb" Info (Maybe FilePath) where
getField (Info {thumb', images}) = thumb' <|> #path <$> find #sfw images
instance HasField "mine" Info Bool where getField = isNothing . #artist
instance HasField "notMine" Info Bool where getField = isJust . #artist
instance FromYAML Info where
parseYAML = YAML.withMap "info" \m ->