add GalleryInfo
This commit is contained in:
parent
2844df96cd
commit
ae5dc6b006
2 changed files with 60 additions and 14 deletions
|
@ -1,6 +1,8 @@
|
||||||
{-# OPTIONS_GHC -Wno-orphans #-}
|
{-# OPTIONS_GHC -Wno-orphans #-}
|
||||||
module Info
|
module Info
|
||||||
(Info (..), Artist (..), Image (..), Link (..),
|
(Info (..), Artist (..), Image (..), Link (..),
|
||||||
|
GalleryInfo (..), GalleryFilters, Who (..),
|
||||||
|
readWho, matchWho, matchNsfw, matchFilters,
|
||||||
-- ** Reexports
|
-- ** Reexports
|
||||||
Day (..), Text)
|
Day (..), Text)
|
||||||
where
|
where
|
||||||
|
@ -11,6 +13,7 @@ import Control.Applicative
|
||||||
import Data.Foldable (find)
|
import Data.Foldable (find)
|
||||||
import qualified Data.Map.Strict as Map
|
import qualified Data.Map.Strict as Map
|
||||||
import Data.Maybe (isJust, isNothing)
|
import Data.Maybe (isJust, isNothing)
|
||||||
|
import Data.String (IsString)
|
||||||
import Data.Text (Text)
|
import Data.Text (Text)
|
||||||
import qualified Data.Text as Text
|
import qualified Data.Text as Text
|
||||||
import Data.Time.Calendar (Day (..))
|
import Data.Time.Calendar (Day (..))
|
||||||
|
@ -98,6 +101,63 @@ instance FromYAML Link where
|
||||||
parseYAML = labelledOptNsfw Link "url" "url"
|
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
|
data Pair a b = Pair !a !b
|
||||||
|
|
||||||
instance (FromYAML a, FromYAML b) => FromYAML (Pair a b) where
|
instance (FromYAML a, FromYAML b) => FromYAML (Pair a b) where
|
||||||
|
|
|
@ -31,20 +31,6 @@ data ModeOptions =
|
||||||
}
|
}
|
||||||
deriving Show
|
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 :: ParserInfo Options
|
||||||
optionsParser = globalOpts `info` mainInfo where
|
optionsParser = globalOpts `info` mainInfo where
|
||||||
|
|
Loading…
Reference in a new issue