{-# LANGUAGE GHC2021 #-} {-# LANGUAGE OverloadedStrings #-} -- | Music catalog: featured works + grouped-by-category listing. -- Renders HTML directly (same pattern as Backlinks.hs) to avoid the -- complexity of nested listFieldWith. module Catalog ( musicCatalogCtx ) where import Data.List (groupBy, sortBy) import Data.Maybe (fromMaybe) import Data.Ord (comparing) import Data.Aeson (Value (..)) import qualified Data.Aeson.KeyMap as KM import qualified Data.Vector as V import qualified Data.Text as T import Hakyll import Hakyll.Core.Metadata (lookupStringList) import Contexts (siteCtx) -- --------------------------------------------------------------------------- -- Entry type -- --------------------------------------------------------------------------- data CatalogEntry = CatalogEntry { ceTitle :: String , ceUrl :: String , ceYear :: Maybe String , ceDuration :: Maybe String , ceInstrumentation :: Maybe String , ceCategory :: String -- defaults to "other" , ceFeatured :: Bool , ceHasScore :: Bool , ceHasRecording :: Bool } -- --------------------------------------------------------------------------- -- Category helpers -- --------------------------------------------------------------------------- categoryOrder :: [String] categoryOrder = ["orchestral","chamber","solo","vocal","choral","electronic","other"] categoryLabel :: String -> String categoryLabel "orchestral" = "Orchestral" categoryLabel "chamber" = "Chamber" categoryLabel "solo" = "Solo" categoryLabel "vocal" = "Vocal" categoryLabel "choral" = "Choral" categoryLabel "electronic" = "Electronic" categoryLabel _ = "Other" categoryRank :: String -> Int categoryRank c = fromMaybe (length categoryOrder) (lookup c (zip categoryOrder [0..])) -- --------------------------------------------------------------------------- -- Parsing helpers -- --------------------------------------------------------------------------- -- | @featured: true@ in YAML becomes Bool True in Aeson; also accept the -- string "true" in case the author quotes it. isFeatured :: Metadata -> Bool isFeatured meta = case KM.lookup "featured" meta of Just (Bool True) -> True Just (String "true") -> True _ -> False -- | True if a @recording@ key is present, or any movement has an @audio@ key. hasRecordingMeta :: Metadata -> Bool hasRecordingMeta meta = KM.member "recording" meta || anyMovHasAudio meta where anyMovHasAudio m = case KM.lookup "movements" m of Just (Array v) -> any movHasAudio (V.toList v) _ -> False movHasAudio (Object o) = KM.member "audio" o movHasAudio _ = False -- | Parse a year: accepts Number (e.g. @year: 2019@) or String. parseYear :: Metadata -> Maybe String parseYear meta = case KM.lookup "year" meta of Just (Number n) -> Just $ show (floor (fromRational (toRational n) :: Double) :: Int) Just (String t) -> Just (T.unpack t) _ -> Nothing parseCatalogEntry :: Item String -> Compiler (Maybe CatalogEntry) parseCatalogEntry item = do meta <- getMetadata (itemIdentifier item) mRoute <- getRoute (itemIdentifier item) case mRoute of Nothing -> return Nothing Just r -> do let title = fromMaybe "(untitled)" (lookupString "title" meta) url = "/" ++ r year = parseYear meta dur = lookupString "duration" meta instr = lookupString "instrumentation" meta cat = fromMaybe "other" (lookupString "category" meta) return $ Just CatalogEntry { ceTitle = title , ceUrl = url , ceYear = year , ceDuration = dur , ceInstrumentation = instr , ceCategory = cat , ceFeatured = isFeatured meta , ceHasScore = not (null (fromMaybe [] (lookupStringList "score-pages" meta))) , ceHasRecording = hasRecordingMeta meta } -- --------------------------------------------------------------------------- -- HTML rendering -- --------------------------------------------------------------------------- renderIndicators :: CatalogEntry -> String renderIndicators e = concatMap render [ (ceHasScore e, "◼") , (ceHasRecording e, "♪") ] where render (True, s) = s render (False, _) = "" renderEntry :: CatalogEntry -> String renderEntry e = concat [ "
Works forthcoming.
" else do let sorted = sortBy (comparing (categoryRank . ceCategory)) entries grouped = groupBy (\a b -> ceCategory a == ceCategory b) sorted return $ concatMap (\g -> renderCategorySection (ceCategory (head g)) g) grouped musicCatalogCtx :: Context String musicCatalogCtx = constField "catalog" "true" <> hasFeaturedField <> featuredWorksField <> catalogByCategoryField <> siteCtx