203 lines
7.8 KiB
Haskell
203 lines
7.8 KiB
Haskell
{-# 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, "<span class=\"catalog-ind\" title=\"Score available\">◼</span>")
|
|
, (ceHasRecording e, "<span class=\"catalog-ind\" title=\"Recording available\">♪</span>")
|
|
]
|
|
where
|
|
render (True, s) = s
|
|
render (False, _) = ""
|
|
|
|
renderEntry :: CatalogEntry -> String
|
|
renderEntry e = concat
|
|
[ "<li class=\"catalog-entry\">"
|
|
, "<div class=\"catalog-entry-main\">"
|
|
, "<a class=\"catalog-title\" href=\"", ceUrl e, "\">", ceTitle e, "</a>"
|
|
, renderIndicators e
|
|
, maybe "" (\y -> "<span class=\"catalog-year\">" ++ y ++ "</span>") (ceYear e)
|
|
, maybe "" (\d -> "<span class=\"catalog-duration\">" ++ d ++ "</span>") (ceDuration e)
|
|
, "</div>"
|
|
, maybe "" (\i -> "<div class=\"catalog-instrumentation\">" ++ i ++ "</div>") (ceInstrumentation e)
|
|
, "</li>"
|
|
]
|
|
|
|
renderCategorySection :: String -> [CatalogEntry] -> String
|
|
renderCategorySection cat entries = concat
|
|
[ "<section class=\"catalog-section\">"
|
|
, "<h2 class=\"catalog-section-title\">", categoryLabel cat, "</h2>"
|
|
, "<ul class=\"catalog-list\">"
|
|
, concatMap renderEntry entries
|
|
, "</ul>"
|
|
, "</section>"
|
|
]
|
|
|
|
-- ---------------------------------------------------------------------------
|
|
-- Load all compositions (excluding the catalog index itself)
|
|
-- ---------------------------------------------------------------------------
|
|
|
|
loadEntries :: Compiler [CatalogEntry]
|
|
loadEntries = do
|
|
items <- loadAll ("content/music/*/index.md" .&&. hasNoVersion)
|
|
mItems <- mapM parseCatalogEntry items
|
|
return [e | Just e <- mItems]
|
|
|
|
-- ---------------------------------------------------------------------------
|
|
-- Context fields
|
|
-- ---------------------------------------------------------------------------
|
|
|
|
-- | @$featured-works$@: HTML list of featured entries; noResult when none.
|
|
featuredWorksField :: Context String
|
|
featuredWorksField = field "featured-works" $ \_ -> do
|
|
entries <- loadEntries
|
|
let featured = filter ceFeatured entries
|
|
if null featured
|
|
then fail "no featured works"
|
|
else return $
|
|
"<ul class=\"catalog-list catalog-featured-list\">"
|
|
++ concatMap renderEntry featured
|
|
++ "</ul>"
|
|
|
|
-- | @$has-featured$@: present when at least one composition is featured.
|
|
hasFeaturedField :: Context String
|
|
hasFeaturedField = field "has-featured" $ \_ -> do
|
|
entries <- loadEntries
|
|
if any ceFeatured entries then return "true" else fail "no featured works"
|
|
|
|
-- | @$catalog-by-category$@: HTML for all category sections.
|
|
-- Sorted by canonical category order; if no compositions exist yet,
|
|
-- returns a placeholder paragraph.
|
|
catalogByCategoryField :: Context String
|
|
catalogByCategoryField = field "catalog-by-category" $ \_ -> do
|
|
entries <- loadEntries
|
|
if null entries
|
|
then return "<p class=\"catalog-empty\">Works forthcoming.</p>"
|
|
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
|