add GalleryInfo

This commit is contained in:
Rhiannon Morris 2020-07-16 11:48:09 +02:00
parent 2844df96cd
commit ae5dc6b006
2 changed files with 60 additions and 14 deletions

View file

@ -1,6 +1,8 @@
{-# OPTIONS_GHC -Wno-orphans #-}
module Info
(Info (..), Artist (..), Image (..), Link (..),
GalleryInfo (..), GalleryFilters, Who (..),
readWho, matchWho, matchNsfw, matchFilters,
-- ** Reexports
Day (..), Text)
where
@ -11,6 +13,7 @@ import Control.Applicative
import Data.Foldable (find)
import qualified Data.Map.Strict as Map
import Data.Maybe (isJust, isNothing)
import Data.String (IsString)
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Time.Calendar (Day (..))
@ -98,6 +101,63 @@ instance FromYAML Link where
parseYAML = labelledOptNsfw Link "url" "url"
data GalleryInfo =
GalleryInfo {
prefix :: !FilePath,
name :: !Text,
filters :: !GalleryFilters,
ordering :: !Int -- sorted by @ordering@ on gallery list page
}
deriving (Eq, Show)
data GalleryFilters =
GalleryFilters {
nsfw :: Maybe Bool,
who :: Who
}
deriving (Eq, Show)
data Who = Mine | NotMine | All deriving (Eq, Show)
matchNsfw :: Maybe Bool -> Info -> Bool
matchNsfw Nothing _ = True
matchNsfw (Just nsfw) i = #allNsfw i == nsfw
readWho :: (IsString str, Eq str, Alternative f) => str -> f Who
readWho "mine" = pure Mine
readWho "not-mine" = pure NotMine
readWho "all" = pure All
readWho _ = empty
matchWho :: Who -> Info -> Bool
matchWho Mine = #mine
matchWho NotMine = #notMine
matchWho All = const True
noFilters :: GalleryFilters
noFilters = GalleryFilters {nsfw = Nothing, who = All}
matchFilters :: GalleryFilters -> Info -> Bool
matchFilters (GalleryFilters {nsfw, who}) i =
matchNsfw nsfw i && matchWho who i
instance FromYAML GalleryInfo where
parseYAML = YAML.withMap "gallery info" \m ->
GalleryInfo <$> m .: "prefix"
<*> m .: "name"
<*> m .:? "filters" .!= noFilters
<*> m .:? "ordering" .!= 0
instance FromYAML GalleryFilters where
parseYAML = YAML.withMap "gallery filters" \m ->
GalleryFilters <$> m .:? "nsfw"
<*> m .:? "who" .!= All
instance FromYAML Who where parseYAML = YAML.withStr "who" readWho
data Pair a b = Pair !a !b
instance (FromYAML a, FromYAML b) => FromYAML (Pair a b) where

View file

@ -31,20 +31,6 @@ data ModeOptions =
}
deriving Show
data Who = Mine | NotMine | All deriving (Eq, Show)
readWho :: String -> Maybe Who
readWho "mine" = Just Mine
readWho "not-mine" = Just NotMine
readWho "all" = Just All
readWho _ = Nothing
matchWho :: Who -> Info -> Bool
matchWho Mine = #mine
matchWho NotMine = #notMine
matchWho _ = const True
optionsParser :: ParserInfo Options
optionsParser = globalOpts `info` mainInfo where