diff --git a/make-pages/Info.hs b/make-pages/Info.hs index a661c17..b326b97 100644 --- a/make-pages/Info.hs +++ b/make-pages/Info.hs @@ -28,29 +28,33 @@ module Info where import Date -import GHC.Records - import Control.Applicative -import Control.Monad import Control.Exception +import Control.Monad +import Data.Bitraversable (bitraverse) import Data.Foldable (find) -import Data.Hashable (Hashable) +import Data.HashMap.Strict (HashMap) +import Data.HashMap.Strict qualified as HashMap import Data.HashSet (HashSet) -import qualified Data.HashSet as HashSet -import qualified Data.Map.Strict as Map -import Data.Set (Set, (\\)) -import qualified Data.Set as Set -import Data.Maybe (isJust, isNothing, fromMaybe, mapMaybe, catMaybes) +import Data.HashSet qualified as HashSet +import Data.Hashable (Hashable (..)) import Data.List (sortBy) import Data.List.NonEmpty (NonEmpty (..), toList, nonEmpty) +import Data.Map.Strict qualified as Map +import Data.Maybe (isJust, isNothing, fromMaybe, mapMaybe, catMaybes) import Data.Ord (comparing) +import Data.Semigroup +import Data.Set (Set, (\\)) +import Data.Set qualified as Set import Data.String (IsString) import Data.Text (Text) -import qualified Data.Text as Text +import Data.Text qualified as Text import Data.YAML (FromYAML (..), (.:), (.:?), (.!=)) -import qualified Data.YAML as YAML +import Data.YAML qualified as YAML +import GHC.Records import System.FilePath ((), takeBaseName, takeExtension, splitExtension) -import Data.Semigroup +import Text.Regex.TDFA (Regex) +import Text.Regex.TDFA qualified as Regex data Info = @@ -519,18 +523,68 @@ data IndexInfo = desc :: !Text, galleries :: ![GalleryInfo], links :: ![Link], - footer :: !(Maybe Text) + footer :: !(Maybe Text), + tags :: !TagTransforms } deriving Show instance FromYAML IndexInfo where parseYAML = YAML.withMap "index info" \m -> do - checkKeys m ["title", "desc", "galleries", "links", "footer"] + checkKeys m ["title", "desc", "galleries", "links", "footer", "tags"] IndexInfo <$> m .: "title" <*> m .: "desc" <*> m .:? "galleries" .!= [] <*> m .:? "links" .!= [] <*> m .:? "footer" + <*> m .:? "tags" .!= emptyTransforms + +data TagTransforms = + TagTransforms { + implies :: !(HashMap ImpliesKey [Text]), + replace :: !(HashMap Text Text), + replaceWarn :: !(HashMap Text Text), + warn :: !(HashSet Text) + } + deriving Show + +data ImpliesKey = RegexIK Text Regex | LiteralIK Text + +instance Eq ImpliesKey where + RegexIK s _ == RegexIK t _ = s == t + LiteralIK s == LiteralIK t = s == t + _ == _ = False + +instance Show ImpliesKey where + showsPrec d (RegexIK s _) = + showParen (d > 10) $ + showString "RegexIK " . showsPrec 11 s . showString " _" + showsPrec d (LiteralIK s) = + showParen (d > 10) $ showString "LiteralIK " . showsPrec 11 s + +instance Hashable ImpliesKey where + hashWithSalt s (RegexIK str _) = hashWithSalt s ('R', str) + hashWithSalt s (LiteralIK str) = hashWithSalt s ('L', str) + +emptyTransforms :: TagTransforms +emptyTransforms = TagTransforms [] [] [] [] + +instance FromYAML TagTransforms where + parseYAML = YAML.withMap "tag transforms" \m -> do + checkKeys m ["implies", "replace", "replace-warn", "warn"] + TagTransforms <$> m .:? "implies" .!= [] + <*> m .:? "replace" .!= [] + <*> m .:? "replace-warn" .!= [] + <*> m .:? "warn" .!= [] + +instance FromYAML ImpliesKey where + parseYAML = YAML.withStr "string or regex" \str -> pure + if Text.length str > 2 && + Text.head str == '/' && + Text.last str == '/' + then + let body = Text.drop 1 $ Text.dropEnd 1 str in + RegexIK body (Regex.makeRegex body) + else LiteralIK str data Pair a b = Pair !a !b @@ -557,3 +611,10 @@ instance {-# OVERLAPPING #-} FromYAML String where instance (FromYAML a, Eq a, Hashable a) => FromYAML (HashSet a) where parseYAML y = HashSet.fromList <$> parseYAML y + +instance (FromYAML k, Eq k, Hashable k, FromYAML v) => + FromYAML (HashMap k v) where + parseYAML = YAML.withMap "mapping" $ + fmap HashMap.fromList . + traverse (bitraverse parseYAML parseYAML) . + Map.toList diff --git a/make-pages/make-pages.cabal b/make-pages/make-pages.cabal index 182ef70..e842fb2 100644 --- a/make-pages/make-pages.cabal +++ b/make-pages/make-pages.cabal @@ -52,6 +52,7 @@ executable make-pages HsYAML ^>= 0.2.1.0, optparse-applicative ^>= 0.15.1.0, process ^>= 1.6.8.2, + regex-tdfa == 1.3.2.*, template-haskell >= 2.18.0.0 && < 2.23, text >= 1.2.3.1 && < 2.2, time >= 1.8.0.2 && < 1.13,