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 -> FilePath
thumbnail (Info {thumb = Just t}) = t thumbnail = fromMaybe (error "no thumbnail or sfw images") . #thumb
thumbnail (Info {images})
| Just i <- find #sfw images = #path i
| otherwise = error "no thumbnail or sfw images"
addSuffix :: String -> FilePath -> FilePath addSuffix :: String -> FilePath -> FilePath
addSuffix suf path = addSuffix suf path =

20
make-pages/Info.hs
View File

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