{-# LANGUAGE DeriveGeneric, DuplicateRecordFields, OverloadedStrings #-}
module Rules.DisneyExperienceSummary (rules) where

import           Control.Monad                    (filterM)
import           Control.Monad.Reader             (asks)
import           Control.Monad.Trans              (MonadTrans (..))
import           Data.Aeson                       (encode)
import qualified Data.ByteString.Lazy             as BL
import           Data.Char                        (isDigit)
import           Data.Disney.Experience.Generator
import           Data.List                        (foldl', isPrefixOf,
                                                   isSuffixOf, nub, sort,
                                                   sortBy, sortOn)
import qualified Data.Map                         as M
import           Data.Maybe                       (fromMaybe)
import           Data.Ord                         (comparing)
import           Data.String                      (IsString (..))
import           Data.Time                        (defaultTimeLocale,
                                                   formatTime)
import           Dhall                            (FromDhall, Generic, Natural,
                                                   auto, input)
import           Hakyll
import           System.Directory                 (doesFileExist,
                                                   getModificationTime,
                                                   listDirectory)
import           System.FilePath                  (joinPath, (</>))
import qualified System.FilePath.Posix            as Posix
import           System.FilePath.Posix            (takeBaseName)

import           Config                           (contentsRoot, readerOptions)
import           Contexts                         (siteCtx)
import           Media.SVG                        (mermaidTransform)
import           Rules.PageType
import           Text.HTML.TagSoup                (innerText, parseTags)
import           Text.Pandoc.Walk                 (walkM)
import           Utils                            (mconcatM,
                                                   modifyExternalLinkAttr)
import qualified Vendor.FontAwesome               as FA

data Favorite = Favorite {
    Favorite -> [Char]
text     :: String
  , Favorite -> [Char]
category :: String
  , Favorite -> Maybe [Char]
link     :: Maybe String
  } deriving ((forall x. Favorite -> Rep Favorite x)
-> (forall x. Rep Favorite x -> Favorite) -> Generic Favorite
forall x. Rep Favorite x -> Favorite
forall x. Favorite -> Rep Favorite x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Favorite -> Rep Favorite x
from :: forall x. Favorite -> Rep Favorite x
$cto :: forall x. Rep Favorite x -> Favorite
to :: forall x. Rep Favorite x -> Favorite
Generic, Int -> Favorite -> ShowS
[Favorite] -> ShowS
Favorite -> [Char]
(Int -> Favorite -> ShowS)
-> (Favorite -> [Char]) -> ([Favorite] -> ShowS) -> Show Favorite
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Favorite -> ShowS
showsPrec :: Int -> Favorite -> ShowS
$cshow :: Favorite -> [Char]
show :: Favorite -> [Char]
$cshowList :: [Favorite] -> ShowS
showList :: [Favorite] -> ShowS
Show)

instance FromDhall Favorite

-- ホテルの詳細情報の階層構造（任意階層対応）
data HotelDetail
  = HDText String
  | HDNode { HotelDetail -> [Char]
hdLabel :: String, HotelDetail -> [HotelDetail]
hdChildren :: [HotelDetail] }
  deriving ((forall x. HotelDetail -> Rep HotelDetail x)
-> (forall x. Rep HotelDetail x -> HotelDetail)
-> Generic HotelDetail
forall x. Rep HotelDetail x -> HotelDetail
forall x. HotelDetail -> Rep HotelDetail x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. HotelDetail -> Rep HotelDetail x
from :: forall x. HotelDetail -> Rep HotelDetail x
$cto :: forall x. Rep HotelDetail x -> HotelDetail
to :: forall x. Rep HotelDetail x -> HotelDetail
Generic, Int -> HotelDetail -> ShowS
[HotelDetail] -> ShowS
HotelDetail -> [Char]
(Int -> HotelDetail -> ShowS)
-> (HotelDetail -> [Char])
-> ([HotelDetail] -> ShowS)
-> Show HotelDetail
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HotelDetail -> ShowS
showsPrec :: Int -> HotelDetail -> ShowS
$cshow :: HotelDetail -> [Char]
show :: HotelDetail -> [Char]
$cshowList :: [HotelDetail] -> ShowS
showList :: [HotelDetail] -> ShowS
Show)

-- ホテル情報のデータ構造
data Hotel = Hotel {
    Hotel -> [Char]
hotelCode  :: String
  , Hotel -> Natural
stays      :: Natural
  , Hotel -> [HotelDetail]
details    :: [HotelDetail]
  , Hotel -> [Char]
hotelColor :: String
  } deriving (Int -> Hotel -> ShowS
[Hotel] -> ShowS
Hotel -> [Char]
(Int -> Hotel -> ShowS)
-> (Hotel -> [Char]) -> ([Hotel] -> ShowS) -> Show Hotel
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Hotel -> ShowS
showsPrec :: Int -> Hotel -> ShowS
$cshow :: Hotel -> [Char]
show :: Hotel -> [Char]
$cshowList :: [Hotel] -> ShowS
showList :: [Hotel] -> ShowS
Show)

-- Dhallから読み込むための中間データ構造
data HotelRaw = HotelRaw {
    HotelRaw -> [Char]
hotelCodeRaw  :: String
  , HotelRaw -> Natural
staysRaw      :: Natural
  , HotelRaw -> [[[Char]]]
detailsRaw    :: [[String]]
  , HotelRaw -> [Char]
hotelColorRaw :: String
  } deriving ((forall x. HotelRaw -> Rep HotelRaw x)
-> (forall x. Rep HotelRaw x -> HotelRaw) -> Generic HotelRaw
forall x. Rep HotelRaw x -> HotelRaw
forall x. HotelRaw -> Rep HotelRaw x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. HotelRaw -> Rep HotelRaw x
from :: forall x. HotelRaw -> Rep HotelRaw x
$cto :: forall x. Rep HotelRaw x -> HotelRaw
to :: forall x. Rep HotelRaw x -> HotelRaw
Generic, Int -> HotelRaw -> ShowS
[HotelRaw] -> ShowS
HotelRaw -> [Char]
(Int -> HotelRaw -> ShowS)
-> (HotelRaw -> [Char]) -> ([HotelRaw] -> ShowS) -> Show HotelRaw
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HotelRaw -> ShowS
showsPrec :: Int -> HotelRaw -> ShowS
$cshow :: HotelRaw -> [Char]
show :: HotelRaw -> [Char]
$cshowList :: [HotelRaw] -> ShowS
showList :: [HotelRaw] -> ShowS
Show)

instance FromDhall HotelRaw

buildHotelDetails :: [[String]] -> [HotelDetail]
buildHotelDetails :: [[[Char]]] -> [HotelDetail]
buildHotelDetails = ([HotelDetail] -> [[Char]] -> [HotelDetail])
-> [HotelDetail] -> [[[Char]]] -> [HotelDetail]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (([[Char]] -> [HotelDetail] -> [HotelDetail])
-> [HotelDetail] -> [[Char]] -> [HotelDetail]
forall a b c. (a -> b -> c) -> b -> a -> c
flip [[Char]] -> [HotelDetail] -> [HotelDetail]
insertPath) []

insertPath :: [String] -> [HotelDetail] -> [HotelDetail]
insertPath :: [[Char]] -> [HotelDetail] -> [HotelDetail]
insertPath [] [HotelDetail]
forest           = [HotelDetail]
forest
insertPath [[Char]
leaf] [HotelDetail]
forest       = [Char] -> [HotelDetail] -> [HotelDetail]
insertLeaf [Char]
leaf [HotelDetail]
forest
insertPath ([Char]
label:[[Char]]
rest) [HotelDetail]
forest = [Char] -> [[Char]] -> [HotelDetail] -> [HotelDetail]
insertBranch [Char]
label [[Char]]
rest [HotelDetail]
forest

insertLeaf :: String -> [HotelDetail] -> [HotelDetail]
insertLeaf :: [Char] -> [HotelDetail] -> [HotelDetail]
insertLeaf [Char]
leaf [] = [[Char] -> HotelDetail
HDText [Char]
leaf]
insertLeaf [Char]
leaf (HDText [Char]
txt : [HotelDetail]
xs)
    | [Char]
txt [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
leaf = [Char] -> HotelDetail
HDText [Char]
txt HotelDetail -> [HotelDetail] -> [HotelDetail]
forall a. a -> [a] -> [a]
: [HotelDetail]
xs
    | Bool
otherwise = [Char] -> HotelDetail
HDText [Char]
txt HotelDetail -> [HotelDetail] -> [HotelDetail]
forall a. a -> [a] -> [a]
: [Char] -> [HotelDetail] -> [HotelDetail]
insertLeaf [Char]
leaf [HotelDetail]
xs
insertLeaf [Char]
leaf (node :: HotelDetail
node@HDNode{} : [HotelDetail]
xs) = HotelDetail
node HotelDetail -> [HotelDetail] -> [HotelDetail]
forall a. a -> [a] -> [a]
: [Char] -> [HotelDetail] -> [HotelDetail]
insertLeaf [Char]
leaf [HotelDetail]
xs

insertBranch :: String -> [String] -> [HotelDetail] -> [HotelDetail]
insertBranch :: [Char] -> [[Char]] -> [HotelDetail] -> [HotelDetail]
insertBranch [Char]
label [[Char]]
rest [] =
    [HDNode { $sel:hdLabel:HDText :: [Char]
hdLabel = [Char]
label, $sel:hdChildren:HDText :: [HotelDetail]
hdChildren = [[Char]] -> [HotelDetail] -> [HotelDetail]
insertPath [[Char]]
rest [] }]
insertBranch [Char]
label [[Char]]
rest (node :: HotelDetail
node@HDNode { $sel:hdLabel:HDText :: HotelDetail -> [Char]
hdLabel = [Char]
lbl, $sel:hdChildren:HDText :: HotelDetail -> [HotelDetail]
hdChildren = [HotelDetail]
chldn } : [HotelDetail]
xs)
    | [Char]
lbl [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
label = [Char] -> [HotelDetail] -> HotelDetail
HDNode [Char]
lbl ([[Char]] -> [HotelDetail] -> [HotelDetail]
insertPath [[Char]]
rest [HotelDetail]
chldn) HotelDetail -> [HotelDetail] -> [HotelDetail]
forall a. a -> [a] -> [a]
: [HotelDetail]
xs
    | Bool
otherwise = HotelDetail
node HotelDetail -> [HotelDetail] -> [HotelDetail]
forall a. a -> [a] -> [a]
: [Char] -> [[Char]] -> [HotelDetail] -> [HotelDetail]
insertBranch [Char]
label [[Char]]
rest [HotelDetail]
xs
insertBranch [Char]
label [[Char]]
rest (leaf :: HotelDetail
leaf@HDText{} : [HotelDetail]
xs) = HotelDetail
leaf HotelDetail -> [HotelDetail] -> [HotelDetail]
forall a. a -> [a] -> [a]
: [Char] -> [[Char]] -> [HotelDetail] -> [HotelDetail]
insertBranch [Char]
label [[Char]]
rest [HotelDetail]
xs

-- タグ設定のデータ構造
data TagConfig = TagConfig {
    TagConfig -> [Char]
mapKey   :: String
  , TagConfig -> TagInfo
mapValue :: TagInfo
  } deriving ((forall x. TagConfig -> Rep TagConfig x)
-> (forall x. Rep TagConfig x -> TagConfig) -> Generic TagConfig
forall x. Rep TagConfig x -> TagConfig
forall x. TagConfig -> Rep TagConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TagConfig -> Rep TagConfig x
from :: forall x. TagConfig -> Rep TagConfig x
$cto :: forall x. Rep TagConfig x -> TagConfig
to :: forall x. Rep TagConfig x -> TagConfig
Generic, Int -> TagConfig -> ShowS
[TagConfig] -> ShowS
TagConfig -> [Char]
(Int -> TagConfig -> ShowS)
-> (TagConfig -> [Char])
-> ([TagConfig] -> ShowS)
-> Show TagConfig
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TagConfig -> ShowS
showsPrec :: Int -> TagConfig -> ShowS
$cshow :: TagConfig -> [Char]
show :: TagConfig -> [Char]
$cshowList :: [TagConfig] -> ShowS
showList :: [TagConfig] -> ShowS
Show)

data TagInfo = TagInfo {
    TagInfo -> [Char]
color :: String
  , TagInfo -> [Char]
url   :: String
  } deriving ((forall x. TagInfo -> Rep TagInfo x)
-> (forall x. Rep TagInfo x -> TagInfo) -> Generic TagInfo
forall x. Rep TagInfo x -> TagInfo
forall x. TagInfo -> Rep TagInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TagInfo -> Rep TagInfo x
from :: forall x. TagInfo -> Rep TagInfo x
$cto :: forall x. Rep TagInfo x -> TagInfo
to :: forall x. Rep TagInfo x -> TagInfo
Generic, Int -> TagInfo -> ShowS
[TagInfo] -> ShowS
TagInfo -> [Char]
(Int -> TagInfo -> ShowS)
-> (TagInfo -> [Char]) -> ([TagInfo] -> ShowS) -> Show TagInfo
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TagInfo -> ShowS
showsPrec :: Int -> TagInfo -> ShowS
$cshow :: TagInfo -> [Char]
show :: TagInfo -> [Char]
$cshowList :: [TagInfo] -> ShowS
showList :: [TagInfo] -> ShowS
Show)

instance FromDhall TagConfig
instance FromDhall TagInfo

data LogImage = LogImage {
    LogImage -> [Char]
imageUrl :: String
  , LogImage -> [Char]
imageAlt :: String
  } deriving (Int -> LogImage -> ShowS
[LogImage] -> ShowS
LogImage -> [Char]
(Int -> LogImage -> ShowS)
-> (LogImage -> [Char]) -> ([LogImage] -> ShowS) -> Show LogImage
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LogImage -> ShowS
showsPrec :: Int -> LogImage -> ShowS
$cshow :: LogImage -> [Char]
show :: LogImage -> [Char]
$cshowList :: [LogImage] -> ShowS
showList :: [LogImage] -> ShowS
Show)

-- Dhallファイルからタグ設定を読み込み
loadDisneyTags :: IO [TagConfig]
loadDisneyTags :: IO [TagConfig]
loadDisneyTags = Decoder [TagConfig] -> Text -> IO [TagConfig]
forall a. Decoder a -> Text -> IO a
input Decoder [TagConfig]
forall a. FromDhall a => Decoder a
auto Text
"./contents/config/disney/Tags.dhall"

-- タグ設定をMapに変換
tagConfigMap :: IO (M.Map String (String, String))
tagConfigMap :: IO (Map [Char] ([Char], [Char]))
tagConfigMap = do
    [TagConfig]
tags <- IO [TagConfig]
loadDisneyTags
    Map [Char] ([Char], [Char]) -> IO (Map [Char] ([Char], [Char]))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Map [Char] ([Char], [Char]) -> IO (Map [Char] ([Char], [Char])))
-> Map [Char] ([Char], [Char]) -> IO (Map [Char] ([Char], [Char]))
forall a b. (a -> b) -> a -> b
$ [([Char], ([Char], [Char]))] -> Map [Char] ([Char], [Char])
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([([Char], ([Char], [Char]))] -> Map [Char] ([Char], [Char]))
-> [([Char], ([Char], [Char]))] -> Map [Char] ([Char], [Char])
forall a b. (a -> b) -> a -> b
$ (TagConfig -> ([Char], ([Char], [Char])))
-> [TagConfig] -> [([Char], ([Char], [Char]))]
forall a b. (a -> b) -> [a] -> [b]
map (\TagConfig
tag -> (TagConfig -> [Char]
mapKey TagConfig
tag, (TagInfo -> [Char]
color (TagInfo -> [Char]) -> TagInfo -> [Char]
forall a b. (a -> b) -> a -> b
$ TagConfig -> TagInfo
mapValue TagConfig
tag, TagInfo -> [Char]
url (TagInfo -> [Char]) -> TagInfo -> [Char]
forall a b. (a -> b) -> a -> b
$ TagConfig -> TagInfo
mapValue TagConfig
tag))) [TagConfig]
tags

getTag :: String -> M.Map String (String, String) -> (String, String)
getTag :: [Char] -> Map [Char] ([Char], [Char]) -> ([Char], [Char])
getTag = ([Char], [Char])
-> [Char] -> Map [Char] ([Char], [Char]) -> ([Char], [Char])
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault ([Char]
"#363636", [Char]
"#")

-- タグの色を取得
getTagColor :: String -> M.Map String (String, String) -> String
getTagColor :: [Char] -> Map [Char] ([Char], [Char]) -> [Char]
getTagColor = (([Char], [Char]) -> [Char])
-> (Map [Char] ([Char], [Char]) -> ([Char], [Char]))
-> Map [Char] ([Char], [Char])
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) ([Char], [Char]) -> [Char]
forall a b. (a, b) -> a
fst ((Map [Char] ([Char], [Char]) -> ([Char], [Char]))
 -> Map [Char] ([Char], [Char]) -> [Char])
-> ([Char] -> Map [Char] ([Char], [Char]) -> ([Char], [Char]))
-> [Char]
-> Map [Char] ([Char], [Char])
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Map [Char] ([Char], [Char]) -> ([Char], [Char])
getTag

-- タグのリンクを取得
getTagLink :: String -> M.Map String (String, String) -> String
getTagLink :: [Char] -> Map [Char] ([Char], [Char]) -> [Char]
getTagLink = (([Char], [Char]) -> [Char])
-> (Map [Char] ([Char], [Char]) -> ([Char], [Char]))
-> Map [Char] ([Char], [Char])
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) ([Char], [Char]) -> [Char]
forall a b. (a, b) -> b
snd ((Map [Char] ([Char], [Char]) -> ([Char], [Char]))
 -> Map [Char] ([Char], [Char]) -> [Char])
-> ([Char] -> Map [Char] ([Char], [Char]) -> ([Char], [Char]))
-> [Char]
-> Map [Char] ([Char], [Char])
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Map [Char] ([Char], [Char]) -> ([Char], [Char])
getTag

-- メタデータ用のトリム関数
trimMeta :: String -> String
trimMeta :: ShowS
trimMeta = ShowS
f ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
f
  where f :: ShowS
f = ShowS
forall a. [a] -> [a]
reverse ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ([Char]
" \n\r\t" :: String))

-- HTMLタグを除去してプレーンテキストを取得
stripHtmlTags :: String -> String
stripHtmlTags :: ShowS
stripHtmlTags = [Tag [Char]] -> [Char]
forall str. StringLike str => [Tag str] -> str
innerText ([Tag [Char]] -> [Char]) -> ([Char] -> [Tag [Char]]) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Tag [Char]]
forall str. StringLike str => str -> [Tag str]
parseTags

-- SNSリンクのメタデータを処理するためのフィールド
snsLinksField :: String -> Context String
snsLinksField :: [Char] -> Context [Char]
snsLinksField [Char]
snsType = [Char]
-> Context [Char]
-> (Item [Char] -> Compiler [Item [Char]])
-> Context [Char]
forall a b.
[Char] -> Context a -> (Item b -> Compiler [Item a]) -> Context b
listFieldWith ([Char]
snsType [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"-links") ([Char] -> (Item [Char] -> Compiler [Char]) -> Context [Char]
forall a. [Char] -> (Item a -> Compiler [Char]) -> Context a
field [Char]
"url" ([Char] -> Compiler [Char]
forall a. a -> Compiler a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> Compiler [Char])
-> (Item [Char] -> [Char]) -> Item [Char] -> Compiler [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Item [Char] -> [Char]
forall a. Item a -> a
itemBody)) ((Item [Char] -> Compiler [Item [Char]]) -> Context [Char])
-> (Item [Char] -> Compiler [Item [Char]]) -> Context [Char]
forall a b. (a -> b) -> a -> b
$ \Item [Char]
item -> do
    Maybe [Char]
mUrls <- Identifier -> [Char] -> Compiler (Maybe [Char])
forall (m :: * -> *).
MonadMetadata m =>
Identifier -> [Char] -> m (Maybe [Char])
getMetadataField (Item [Char] -> Identifier
forall a. Item a -> Identifier
itemIdentifier Item [Char]
item) [Char]
snsType
    case Maybe [Char]
mUrls of
        Just [Char]
urlsStr -> [Item [Char]] -> Compiler [Item [Char]]
forall a. a -> Compiler a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Item [Char]] -> Compiler [Item [Char]])
-> [Item [Char]] -> Compiler [Item [Char]]
forall a b. (a -> b) -> a -> b
$ ([Char] -> Item [Char]) -> [[Char]] -> [Item [Char]]
forall a b. (a -> b) -> [a] -> [b]
map (\[Char]
url -> Identifier -> [Char] -> Item [Char]
forall a. Identifier -> a -> Item a
Item ([Char] -> Identifier
forall a. IsString a => [Char] -> a
fromString [Char]
url) (ShowS
trimMeta [Char]
url)) ([Char] -> [Char] -> [[Char]]
splitAll [Char]
"," [Char]
urlsStr)
        Maybe [Char]
Nothing     -> [Item [Char]] -> Compiler [Item [Char]]
forall a. a -> Compiler a
forall (m :: * -> *) a. Monad m => a -> m a
return []

-- タグのメタデータを処理するためのフィールド
disneyTagsField :: M.Map String (String, String) -> Context String
disneyTagsField :: Map [Char] ([Char], [Char]) -> Context [Char]
disneyTagsField Map [Char] ([Char], [Char])
tagConfig = [Char]
-> Context [Char]
-> (Item [Char] -> Compiler [Item [Char]])
-> Context [Char]
forall a b.
[Char] -> Context a -> (Item b -> Compiler [Item a]) -> Context b
listFieldWith [Char]
"disney-tags-list" Context [Char]
tagCtx ((Item [Char] -> Compiler [Item [Char]]) -> Context [Char])
-> (Item [Char] -> Compiler [Item [Char]]) -> Context [Char]
forall a b. (a -> b) -> a -> b
$ \Item [Char]
item -> do
    Maybe [Char]
mTags <- Identifier -> [Char] -> Compiler (Maybe [Char])
forall (m :: * -> *).
MonadMetadata m =>
Identifier -> [Char] -> m (Maybe [Char])
getMetadataField (Item [Char] -> Identifier
forall a. Item a -> Identifier
itemIdentifier Item [Char]
item) [Char]
"disney-tags"
    case Maybe [Char]
mTags of
        Just [Char]
tagsStr -> [Item [Char]] -> Compiler [Item [Char]]
forall a. a -> Compiler a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Item [Char]] -> Compiler [Item [Char]])
-> [Item [Char]] -> Compiler [Item [Char]]
forall a b. (a -> b) -> a -> b
$ ([Char] -> Item [Char]) -> [[Char]] -> [Item [Char]]
forall a b. (a -> b) -> [a] -> [b]
map (\[Char]
tag -> Identifier -> [Char] -> Item [Char]
forall a. Identifier -> a -> Item a
Item ([Char] -> Identifier
forall a. IsString a => [Char] -> a
fromString [Char]
tag) [Char]
tag) ([[Char]] -> [Item [Char]]) -> [[Char]] -> [Item [Char]]
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [[Char]]
forall a. Ord a => [a] -> [a]
sort ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ ([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> ([Char] -> Bool) -> [Char] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ ShowS -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ShowS
trimMeta ([Char] -> [Char] -> [[Char]]
splitAll [Char]
"," [Char]
tagsStr)
        Maybe [Char]
Nothing      -> [Item [Char]] -> Compiler [Item [Char]]
forall a. a -> Compiler a
forall (m :: * -> *) a. Monad m => a -> m a
return []
  where
    tagCtx :: Context [Char]
tagCtx = [Char] -> (Item [Char] -> Compiler [Char]) -> Context [Char]
forall a. [Char] -> (Item a -> Compiler [Char]) -> Context a
field [Char]
"name" ([Char] -> Compiler [Char]
forall a. a -> Compiler a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> Compiler [Char])
-> (Item [Char] -> [Char]) -> Item [Char] -> Compiler [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Item [Char] -> [Char]
forall a. Item a -> a
itemBody)
          Context [Char] -> Context [Char] -> Context [Char]
forall a. Semigroup a => a -> a -> a
<> [Char] -> (Item [Char] -> Compiler [Char]) -> Context [Char]
forall a. [Char] -> (Item a -> Compiler [Char]) -> Context a
field [Char]
"color" ([Char] -> Compiler [Char]
forall a. a -> Compiler a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> Compiler [Char])
-> (Item [Char] -> [Char]) -> Item [Char] -> Compiler [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> Map [Char] ([Char], [Char]) -> [Char])
-> Map [Char] ([Char], [Char]) -> ShowS
forall a b c. (a -> b -> c) -> b -> a -> c
flip [Char] -> Map [Char] ([Char], [Char]) -> [Char]
getTagColor Map [Char] ([Char], [Char])
tagConfig ShowS -> (Item [Char] -> [Char]) -> Item [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Item [Char] -> [Char]
forall a. Item a -> a
itemBody)
          Context [Char] -> Context [Char] -> Context [Char]
forall a. Semigroup a => a -> a -> a
<> [Char] -> (Item [Char] -> Compiler [Char]) -> Context [Char]
forall a. [Char] -> (Item a -> Compiler [Char]) -> Context a
field [Char]
"link" ([Char] -> Compiler [Char]
forall a. a -> Compiler a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> Compiler [Char])
-> (Item [Char] -> [Char]) -> Item [Char] -> Compiler [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> Map [Char] ([Char], [Char]) -> [Char])
-> Map [Char] ([Char], [Char]) -> ShowS
forall a b c. (a -> b -> c) -> b -> a -> c
flip [Char] -> Map [Char] ([Char], [Char]) -> [Char]
getTagLink Map [Char] ([Char], [Char])
tagConfig ShowS -> (Item [Char] -> [Char]) -> Item [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Item [Char] -> [Char]
forall a. Item a -> a
itemBody)

disneyExperienceSummaryRoot :: FilePath
disneyExperienceSummaryRoot :: [Char]
disneyExperienceSummaryRoot = [[Char]] -> [Char]
joinPath [[Char]
contentsRoot, [Char]
"disney_experience_summary"]

aboutIdent :: Identifier
aboutIdent :: Identifier
aboutIdent = [Char] -> Identifier
forall a. IsString a => [Char] -> a
fromString
    ([Char] -> Identifier) -> [Char] -> Identifier
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
joinPath [[Char]
disneyExperienceSummaryRoot, [Char]
"about.md"]

disneyLogsPattern :: Pattern
disneyLogsPattern :: Pattern
disneyLogsPattern = [Char] -> Pattern
fromRegex ([Char] -> Pattern) -> [Char] -> Pattern
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
forall a. Monoid a => [a] -> a
mconcat
    [ [Char]
"(^"
    , [[Char]] -> [Char]
joinPath [[Char]
disneyExperienceSummaryRoot, [Char]
"logs", [Char]
"[0-9]+.md"]
    , [Char]
"$)|(^"
    , [[Char]] -> [Char]
joinPath [[Char]
disneyExperienceSummaryRoot, [Char]
"logs", [Char]
"[0-9]+", [Char]
"index.md"]
    , [Char]
"$)"
    ]

sortByNum :: [Item a] -> [Item a]
sortByNum :: forall a. [Item a] -> [Item a]
sortByNum = (Item a -> Item a -> Ordering) -> [Item a] -> [Item a]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy
    ((Item a -> Item a -> Ordering) -> [Item a] -> [Item a])
-> (Item a -> Item a -> Ordering) -> [Item a] -> [Item a]
forall a b. (a -> b) -> a -> b
$ (Item a -> Item a -> Ordering) -> Item a -> Item a -> Ordering
forall a b c. (a -> b -> c) -> b -> a -> c
flip
    ((Item a -> Item a -> Ordering) -> Item a -> Item a -> Ordering)
-> (Item a -> Item a -> Ordering) -> Item a -> Item a -> Ordering
forall a b. (a -> b) -> a -> b
$ (Item a -> Int) -> Item a -> Item a -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing
    ((Item a -> Int) -> Item a -> Item a -> Ordering)
-> (Item a -> Int) -> Item a -> Item a -> Ordering
forall a b. (a -> b) -> a -> b
$ Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe (Int
0 :: Int) (Maybe Int -> Int) -> (Item a -> Maybe Int) -> Item a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Maybe Int
extractLogNumber ([Char] -> Maybe Int) -> (Item a -> [Char]) -> Item a -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identifier -> [Char]
toFilePath (Identifier -> [Char])
-> (Item a -> Identifier) -> Item a -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Item a -> Identifier
forall a. Item a -> Identifier
itemIdentifier
  where
    extractLogNumber :: FilePath -> Maybe Int
    extractLogNumber :: [Char] -> Maybe Int
extractLogNumber [Char]
filePath =
        let candidates :: [[Char]]
candidates = [ShowS
takeBaseName [Char]
filePath, ShowS
takeBaseName (ShowS
Posix.takeDirectory [Char]
filePath)]
            digitsOnly :: [[Char]]
digitsOnly = ([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Char -> Bool) -> [Char] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit) [[Char]]
candidates
        in case [[Char]]
digitsOnly of
            ([Char]
x:[[Char]]
_) -> Int -> Maybe Int
forall a. a -> Maybe a
Just ([Char] -> Int
forall a. Read a => [Char] -> a
read [Char]
x)
            [[Char]]
_     -> Maybe Int
forall a. Maybe a
Nothing

mdRule :: Snapshot
    -> Pattern
    -> PageConfReader Rules ()
mdRule :: [Char] -> Pattern -> PageConfReader Rules ()
mdRule [Char]
ss Pattern
pat = do
    WriterOptions
wOpt <- (PageConf -> WriterOptions) -> ReaderT PageConf Rules WriterOptions
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks PageConf -> WriterOptions
pcWriterOpt
    KaTeXRender
katexRender <- (PageConf -> KaTeXRender) -> ReaderT PageConf Rules KaTeXRender
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks PageConf -> KaTeXRender
pcKaTeXRender
    FontAwesomeIcons
faIcons <- (PageConf -> FontAwesomeIcons)
-> ReaderT PageConf Rules FontAwesomeIcons
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks PageConf -> FontAwesomeIcons
pcFaIcons
    Rules () -> PageConfReader Rules ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT PageConf m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Rules () -> PageConfReader Rules ())
-> Rules () -> PageConfReader Rules ()
forall a b. (a -> b) -> a -> b
$ Pattern -> Rules () -> Rules ()
match Pattern
pat (Rules () -> Rules ()) -> Rules () -> Rules ()
forall a b. (a -> b) -> a -> b
$ Compiler (Item [Char]) -> Rules ()
forall a.
(Binary a, Typeable a, Writable a) =>
Compiler (Item a) -> Rules ()
compile (Compiler (Item [Char]) -> Rules ())
-> Compiler (Item [Char]) -> Rules ()
forall a b. (a -> b) -> a -> b
$ do
        ReaderOptions
-> WriterOptions
-> (Pandoc -> Compiler Pandoc)
-> Compiler (Item [Char])
pandocCompilerWithTransformM ReaderOptions
readerOptions WriterOptions
wOpt ((Block -> Compiler Block) -> Pandoc -> Compiler Pandoc
forall a b (m :: * -> *).
(Walkable a b, Monad m, Applicative m, Functor m) =>
(a -> m a) -> b -> m b
forall (m :: * -> *).
(Monad m, Applicative m, Functor m) =>
(Block -> m Block) -> Pandoc -> m Pandoc
walkM Block -> Compiler Block
mermaidTransform)
            Compiler (Item [Char]) -> KaTeXRender -> Compiler (Item [Char])
forall a b. Compiler a -> (a -> Compiler b) -> Compiler b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= KaTeXRender
modifyExternalLinkAttr
            Compiler (Item [Char]) -> KaTeXRender -> Compiler (Item [Char])
forall a b. Compiler a -> (a -> Compiler b) -> Compiler b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= KaTeXRender
relativizeUrls
            Compiler (Item [Char]) -> KaTeXRender -> Compiler (Item [Char])
forall a b. Compiler a -> (a -> Compiler b) -> Compiler b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FontAwesomeIcons -> KaTeXRender
FA.render FontAwesomeIcons
faIcons
            Compiler (Item [Char]) -> KaTeXRender -> Compiler (Item [Char])
forall a b. Compiler a -> (a -> Compiler b) -> Compiler b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= KaTeXRender
katexRender
            Compiler (Item [Char]) -> KaTeXRender -> Compiler (Item [Char])
forall a b. Compiler a -> (a -> Compiler b) -> Compiler b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> KaTeXRender
forall a.
(Binary a, Typeable a) =>
[Char] -> Item a -> Compiler (Item a)
saveSnapshot [Char]
ss

loadDisneyFavorites :: IO [Favorite]
loadDisneyFavorites :: IO [Favorite]
loadDisneyFavorites = Decoder [Favorite] -> Text -> IO [Favorite]
forall a. Decoder a -> Text -> IO a
input Decoder [Favorite]
forall a. FromDhall a => Decoder a
auto Text
"./contents/config/disney/Favorites.dhall"

-- Dhallファイルからホテル情報を読み込み
loadDisneyHotels :: IO [Hotel]
loadDisneyHotels :: IO [Hotel]
loadDisneyHotels =
    (HotelRaw -> Hotel) -> [HotelRaw] -> [Hotel]
forall a b. (a -> b) -> [a] -> [b]
map HotelRaw -> Hotel
convert ([HotelRaw] -> [Hotel]) -> IO [HotelRaw] -> IO [Hotel]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Decoder [HotelRaw] -> Text -> IO [HotelRaw]
forall a. Decoder a -> Text -> IO a
input Decoder [HotelRaw]
forall a. FromDhall a => Decoder a
auto Text
"./contents/config/disney/Hotels.dhall" :: IO [HotelRaw])
  where
    convert :: HotelRaw -> Hotel
convert (HotelRaw [Char]
codeRaw Natural
staysRaw [[[Char]]]
detailPathsRaw [Char]
colorRaw) =
        Hotel
            { $sel:hotelCode:Hotel :: [Char]
hotelCode = [Char]
codeRaw
            , $sel:stays:Hotel :: Natural
stays = Natural
staysRaw
            , $sel:details:Hotel :: [HotelDetail]
details = [[[Char]]] -> [HotelDetail]
buildHotelDetails [[[Char]]]
detailPathsRaw
            , $sel:hotelColor:Hotel :: [Char]
hotelColor = [Char]
colorRaw
            }

-- Hotels.dhallの最終更新日を取得
getHotelsLastModified :: IO String
getHotelsLastModified :: IO [Char]
getHotelsLastModified = do
    UTCTime
modTime <- [Char] -> IO UTCTime
getModificationTime [Char]
"./contents/config/disney/Hotels.dhall"
    [Char] -> IO [Char]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> IO [Char]) -> [Char] -> IO [Char]
forall a b. (a -> b) -> a -> b
$ TimeLocale -> [Char] -> UTCTime -> [Char]
forall t. FormatTime t => TimeLocale -> [Char] -> t -> [Char]
formatTime TimeLocale
defaultTimeLocale [Char]
"%Y/%m/%d" UTCTime
modTime

-- ディズニーログの最終更新日を取得（最も新しいファイルの日付）
getLogsLastModified :: IO String
getLogsLastModified :: IO [Char]
getLogsLastModified = do
    let logsDir :: [Char]
logsDir = [[Char]] -> [Char]
joinPath [[Char]
contentsRoot, [Char]
"disney_experience_summary", [Char]
"logs"]
    [[Char]]
entries <- [Char] -> IO [[Char]]
listDirectory [Char]
logsDir
    let topLevelMdFiles :: [[Char]]
topLevelMdFiles = [[Char]
logsDir [Char] -> ShowS
</> [Char]
fileName | [Char]
fileName <- [[Char]]
entries, [Char]
".md" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` [Char]
fileName]
        indexMdCandidates :: [[Char]]
indexMdCandidates = [[Char]
logsDir [Char] -> ShowS
</> [Char]
dirName [Char] -> ShowS
</> [Char]
"index.md" | [Char]
dirName <- [[Char]]
entries, (Char -> Bool) -> [Char] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit [Char]
dirName]
    [[Char]]
existingIndexMdFiles <- ([Char] -> IO Bool) -> [[Char]] -> IO [[Char]]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM [Char] -> IO Bool
doesFileExist [[Char]]
indexMdCandidates
    let mdFiles :: [[Char]]
mdFiles = [[Char]]
topLevelMdFiles [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]]
existingIndexMdFiles
    if [[Char]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Char]]
mdFiles
        then [Char] -> IO [Char]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
"-"
        else do
            [UTCTime]
modTimes <- ([Char] -> IO UTCTime) -> [[Char]] -> IO [UTCTime]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM [Char] -> IO UTCTime
getModificationTime [[Char]]
mdFiles
            let latestTime :: UTCTime
latestTime = [UTCTime] -> UTCTime
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [UTCTime]
modTimes
            [Char] -> IO [Char]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> IO [Char]) -> [Char] -> IO [Char]
forall a b. (a -> b) -> a -> b
$ TimeLocale -> [Char] -> UTCTime -> [Char]
forall t. FormatTime t => TimeLocale -> [Char] -> t -> [Char]
formatTime TimeLocale
defaultTimeLocale [Char]
"%Y/%m/%d" UTCTime
latestTime

-- ログエントリ用のコンテキストを作成
disneyLogCtx :: M.Map String (String, String) -> Context String
disneyLogCtx :: Map [Char] ([Char], [Char]) -> Context [Char]
disneyLogCtx Map [Char] ([Char], [Char])
tagConfig = [Context [Char]] -> Context [Char]
forall a. Monoid a => [a] -> a
mconcat
    [ Context [Char]
forall a. Context a
metadataField
    , [Char] -> Context [Char]
bodyField [Char]
"log-body"
    , [Char] -> (Item [Char] -> Compiler [Char]) -> Context [Char]
forall a. [Char] -> (Item a -> Compiler [Char]) -> Context a
field [Char]
"log-body-text" ((Item [Char] -> Compiler [Char]) -> Context [Char])
-> (Item [Char] -> Compiler [Char]) -> Context [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> Compiler [Char]
forall a. a -> Compiler a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> Compiler [Char])
-> (Item [Char] -> [Char]) -> Item [Char] -> Compiler [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
stripHtmlTags ShowS -> (Item [Char] -> [Char]) -> Item [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Item [Char] -> [Char]
forall a. Item a -> a
itemBody
    , [Char] -> Context [Char]
snsLinksField [Char]
"youtube"
    , [Char] -> Context [Char]
snsLinksField [Char]
"instagram"
    , [Char] -> Context [Char]
snsLinksField [Char]
"x"
    , [Char] -> Context [Char]
snsLinksField [Char]
"note"
    , Context [Char]
imageItemsField
    , Map [Char] ([Char], [Char]) -> Context [Char]
disneyTagsField Map [Char] ([Char], [Char])
tagConfig
    , Context [Char]
forall a. Context a
aiGeneratedField
    ]
  where
    imageItemsField :: Context [Char]
imageItemsField = [Char]
-> Context LogImage
-> (Item [Char] -> Compiler [Item LogImage])
-> Context [Char]
forall a b.
[Char] -> Context a -> (Item b -> Compiler [Item a]) -> Context b
listFieldWith [Char]
"image-items" Context LogImage
imageCtx ((Item [Char] -> Compiler [Item LogImage]) -> Context [Char])
-> (Item [Char] -> Compiler [Item LogImage]) -> Context [Char]
forall a b. (a -> b) -> a -> b
$ \Item [Char]
item -> do
        [[Char]]
imagePaths <- Item [Char] -> Compiler [[Char]]
extractImagePaths Item [Char]
item
        [Item LogImage] -> Compiler [Item LogImage]
forall a. a -> Compiler a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Item LogImage] -> Compiler [Item LogImage])
-> [Item LogImage] -> Compiler [Item LogImage]
forall a b. (a -> b) -> a -> b
$ (Int -> [Char] -> Item LogImage)
-> [Int] -> [[Char]] -> [Item LogImage]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> [Char] -> Item LogImage
toImageItem [Int
1 :: Int ..] ([[Char]] -> [Item LogImage]) -> [[Char]] -> [Item LogImage]
forall a b. (a -> b) -> a -> b
$ ShowS -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (Item [Char] -> ShowS
resolveImageUrl Item [Char]
item) [[Char]]
imagePaths

    imageCtx :: Context LogImage
imageCtx = [Context LogImage] -> Context LogImage
forall a. Monoid a => [a] -> a
mconcat
        [ [Char] -> (Item LogImage -> Compiler [Char]) -> Context LogImage
forall a. [Char] -> (Item a -> Compiler [Char]) -> Context a
field [Char]
"url" ([Char] -> Compiler [Char]
forall a. a -> Compiler a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> Compiler [Char])
-> (Item LogImage -> [Char]) -> Item LogImage -> Compiler [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogImage -> [Char]
imageUrl (LogImage -> [Char])
-> (Item LogImage -> LogImage) -> Item LogImage -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Item LogImage -> LogImage
forall a. Item a -> a
itemBody)
        , [Char] -> (Item LogImage -> Compiler [Char]) -> Context LogImage
forall a. [Char] -> (Item a -> Compiler [Char]) -> Context a
field [Char]
"alt" ([Char] -> Compiler [Char]
forall a. a -> Compiler a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> Compiler [Char])
-> (Item LogImage -> [Char]) -> Item LogImage -> Compiler [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogImage -> [Char]
imageAlt (LogImage -> [Char])
-> (Item LogImage -> LogImage) -> Item LogImage -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Item LogImage -> LogImage
forall a. Item a -> a
itemBody)
        ]

    toImageItem :: Int -> String -> Item LogImage
    toImageItem :: Int -> [Char] -> Item LogImage
toImageItem Int
idx [Char]
url =
        Identifier -> LogImage -> Item LogImage
forall a. Identifier -> a -> Item a
Item
            ([Char] -> Identifier
forall a. IsString a => [Char] -> a
fromString ([Char] -> Identifier) -> [Char] -> Identifier
forall a b. (a -> b) -> a -> b
$ [Char]
"image-item-" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
idx)
            LogImage {
                $sel:imageUrl:LogImage :: [Char]
imageUrl = [Char]
url
              , $sel:imageAlt:LogImage :: [Char]
imageAlt = [Char]
"体験録画像 " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
idx
              }

    extractImagePaths :: Item String -> Compiler [String]
    extractImagePaths :: Item [Char] -> Compiler [[Char]]
extractImagePaths Item [Char]
item = do
        Maybe [Char]
mImagePaths <- Identifier -> [Char] -> Compiler (Maybe [Char])
forall (m :: * -> *).
MonadMetadata m =>
Identifier -> [Char] -> m (Maybe [Char])
getMetadataField (Item [Char] -> Identifier
forall a. Item a -> Identifier
itemIdentifier Item [Char]
item) [Char]
"images"
        case Maybe [Char]
mImagePaths of
            Just [Char]
imagePathsStr -> [[Char]] -> Compiler [[Char]]
forall a. a -> Compiler a
forall (m :: * -> *) a. Monad m => a -> m a
return ([[Char]] -> Compiler [[Char]]) -> [[Char]] -> Compiler [[Char]]
forall a b. (a -> b) -> a -> b
$ ([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> ([Char] -> Bool) -> [Char] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ ShowS -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ShowS
trimMeta ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> [[Char]]
splitAll [Char]
"," [Char]
imagePathsStr
            Maybe [Char]
Nothing            -> [[Char]] -> Compiler [[Char]]
forall a. a -> Compiler a
forall (m :: * -> *) a. Monad m => a -> m a
return []

    resolveImageUrl :: Item String -> String -> String
    resolveImageUrl :: Item [Char] -> ShowS
resolveImageUrl Item [Char]
item [Char]
path
        | [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
path = [Char]
path
        | [Char]
"http://" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Char]
path = [Char]
path
        | [Char]
"https://" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Char]
path = [Char]
path
        | [Char] -> Bool
Posix.isAbsolute [Char]
path = [Char]
path
        | Bool
otherwise = ShowS
toPublicUrl
            ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ ShowS
Posix.normalise
            ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ ShowS
Posix.takeDirectory (Identifier -> [Char]
toFilePath (Identifier -> [Char]) -> Identifier -> [Char]
forall a b. (a -> b) -> a -> b
$ Item [Char] -> Identifier
forall a. Item a -> Identifier
itemIdentifier Item [Char]
item) [Char] -> ShowS
</> [Char]
path

    toPublicUrl :: FilePath -> String
    toPublicUrl :: ShowS
toPublicUrl [Char]
filePath
        | [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
filePath = [Char]
filePath
        | [Char] -> Bool
Posix.isAbsolute [Char]
filePath = [Char]
filePath
        | ([Char]
contentsRoot [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"/") [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Char]
filePath =
            let publicPath :: [Char]
publicPath = (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/') ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Int -> ShowS
forall a. Int -> [a] -> [a]
drop ([Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
contentsRoot) [Char]
filePath
            in [Char] -> ShowS
Posix.makeRelative [Char]
"disney_experience_summary" [Char]
publicPath
        | Bool
otherwise = [Char]
filePath

    aiGeneratedField :: Context a
aiGeneratedField = [Char]
-> Context [Char]
-> (Item a -> Compiler [Item [Char]])
-> Context a
forall a b.
[Char] -> Context a -> (Item b -> Compiler [Item a]) -> Context b
listFieldWith [Char]
"ai-generated-badges" Context [Char]
aiGeneratedBadgeCtx ((Item a -> Compiler [Item [Char]]) -> Context a)
-> (Item a -> Compiler [Item [Char]]) -> Context a
forall a b. (a -> b) -> a -> b
$ \Item a
item -> do
        Maybe [Char]
mAiGeneratedBy <- Identifier -> [Char] -> Compiler (Maybe [Char])
forall (m :: * -> *).
MonadMetadata m =>
Identifier -> [Char] -> m (Maybe [Char])
getMetadataField (Item a -> Identifier
forall a. Item a -> Identifier
itemIdentifier Item a
item) [Char]
"ai-generated-by"
        case ShowS -> Maybe [Char] -> Maybe [Char]
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ShowS
trimMeta Maybe [Char]
mAiGeneratedBy of
            Just [Char]
modelName
                | Bool -> Bool
not ([Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
modelName) -> [Item [Char]] -> Compiler [Item [Char]]
forall a. a -> Compiler a
forall (m :: * -> *) a. Monad m => a -> m a
return [Identifier -> [Char] -> Item [Char]
forall a. Identifier -> a -> Item a
Item ([Char] -> Identifier
forall a. IsString a => [Char] -> a
fromString [Char]
"ai") [Char]
modelName]
            Maybe [Char]
_ -> [Item [Char]] -> Compiler [Item [Char]]
forall a. a -> Compiler a
forall (m :: * -> *) a. Monad m => a -> m a
return []

    aiGeneratedBadgeCtx :: Context String
    aiGeneratedBadgeCtx :: Context [Char]
aiGeneratedBadgeCtx = [Context [Char]] -> Context [Char]
forall a. Monoid a => [a] -> a
mconcat
        [ [Char] -> (Item [Char] -> Compiler [Char]) -> Context [Char]
forall a. [Char] -> (Item a -> Compiler [Char]) -> Context a
field [Char]
"badge-text" ((Item [Char] -> Compiler [Char]) -> Context [Char])
-> (Item [Char] -> Compiler [Char]) -> Context [Char]
forall a b. (a -> b) -> a -> b
$ Compiler [Char] -> Item [Char] -> Compiler [Char]
forall a b. a -> b -> a
const (Compiler [Char] -> Item [Char] -> Compiler [Char])
-> Compiler [Char] -> Item [Char] -> Compiler [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> Compiler [Char]
forall a. a -> Compiler a
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
"Generated by AI"
        , [Char] -> (Item [Char] -> Compiler [Char]) -> Context [Char]
forall a. [Char] -> (Item a -> Compiler [Char]) -> Context a
field [Char]
"model-name" ([Char] -> Compiler [Char]
forall a. a -> Compiler a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> Compiler [Char])
-> (Item [Char] -> [Char]) -> Item [Char] -> Compiler [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Item [Char] -> [Char]
forall a. Item a -> a
itemBody)
        ]

-- ホテル情報用のコンテキストを作成
hotelCtx :: Context Hotel
hotelCtx :: Context Hotel
hotelCtx = [Context Hotel] -> Context Hotel
forall a. Monoid a => [a] -> a
mconcat
    [ [Char] -> (Item Hotel -> Compiler [Char]) -> Context Hotel
forall a. [Char] -> (Item a -> Compiler [Char]) -> Context a
field [Char]
"hotel-code" ([Char] -> Compiler [Char]
forall a. a -> Compiler a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> Compiler [Char])
-> (Item Hotel -> [Char]) -> Item Hotel -> Compiler [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hotel -> [Char]
hotelCode (Hotel -> [Char]) -> (Item Hotel -> Hotel) -> Item Hotel -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Item Hotel -> Hotel
forall a. Item a -> a
itemBody)
    , [Char] -> (Item Hotel -> Compiler [Char]) -> Context Hotel
forall a. [Char] -> (Item a -> Compiler [Char]) -> Context a
field [Char]
"stays-count" ([Char] -> Compiler [Char]
forall a. a -> Compiler a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> Compiler [Char])
-> (Item Hotel -> [Char]) -> Item Hotel -> Compiler [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> [Char]
forall a. Show a => a -> [Char]
show (Natural -> [Char])
-> (Item Hotel -> Natural) -> Item Hotel -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hotel -> Natural
stays (Hotel -> Natural)
-> (Item Hotel -> Hotel) -> Item Hotel -> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Item Hotel -> Hotel
forall a. Item a -> a
itemBody)
    , [Char] -> (Item Hotel -> Compiler [Char]) -> Context Hotel
forall a. [Char] -> (Item a -> Compiler [Char]) -> Context a
field [Char]
"hotel-color" ([Char] -> Compiler [Char]
forall a. a -> Compiler a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> Compiler [Char])
-> (Item Hotel -> [Char]) -> Item Hotel -> Compiler [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hotel -> [Char]
hotelColor (Hotel -> [Char]) -> (Item Hotel -> Hotel) -> Item Hotel -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Item Hotel -> Hotel
forall a. Item a -> a
itemBody)
    , [Char] -> (Item Hotel -> Compiler [Char]) -> Context Hotel
forall a. [Char] -> (Item a -> Compiler [Char]) -> Context a
field [Char]
"hotel-details-html" ((Item Hotel -> Compiler [Char]) -> Context Hotel)
-> (Item Hotel -> Compiler [Char]) -> Context Hotel
forall a b. (a -> b) -> a -> b
$ \Item Hotel
item ->
        [Char] -> Compiler [Char]
forall a. a -> Compiler a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> Compiler [Char]) -> [Char] -> Compiler [Char]
forall a b. (a -> b) -> a -> b
$ [HotelDetail] -> [Char]
renderHotelDetails (Hotel -> [HotelDetail]
details (Hotel -> [HotelDetail]) -> Hotel -> [HotelDetail]
forall a b. (a -> b) -> a -> b
$ Item Hotel -> Hotel
forall a. Item a -> a
itemBody Item Hotel
item)
    ]
  where
    -- 階層構造をHTMLに変換
    renderHotelDetails :: [HotelDetail] -> String
    renderHotelDetails :: [HotelDetail] -> [Char]
renderHotelDetails = (HotelDetail -> [Char]) -> [HotelDetail] -> [Char]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int -> HotelDetail -> [Char]
renderDetail Int
0)

    renderDetail :: Int -> HotelDetail -> String
    renderDetail :: Int -> HotelDetail -> [Char]
renderDetail Int
level (HDText [Char]
text) = Int -> ShowS
renderSpan Int
level [Char]
text
    renderDetail Int
level (HDNode {$sel:hdLabel:HDText :: HotelDetail -> [Char]
hdLabel = [Char]
lbl, $sel:hdChildren:HDText :: HotelDetail -> [HotelDetail]
hdChildren = [HotelDetail]
chldn}) =
        Int -> ShowS
renderSpan Int
level [Char]
lbl [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ (HotelDetail -> [Char]) -> [HotelDetail] -> [Char]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int -> HotelDetail -> [Char]
renderDetail (Int
level Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)) [HotelDetail]
chldn

    renderSpan :: Int -> String -> String
    renderSpan :: Int -> ShowS
renderSpan Int
level [Char]
text =
        let classLevel :: Int
classLevel = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
level Int
3
        in [Char]
"<span class=\"hotel-detail-item hotel-detail-level-" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
classLevel [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"\">" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
text [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"</span>"

rules :: PageConfReader Rules ()
rules :: PageConfReader Rules ()
rules = do
    let items :: [Pattern]
items = Pattern
disneyLogsPattern Pattern -> [Pattern] -> [Pattern]
forall a. a -> [a] -> [a]
: (Identifier -> Pattern) -> [Identifier] -> [Pattern]
forall a b. (a -> b) -> [a] -> [b]
map ([Identifier] -> Pattern
fromList ([Identifier] -> Pattern)
-> (Identifier -> [Identifier]) -> Identifier -> Pattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Identifier -> [Identifier] -> [Identifier]
forall a. a -> [a] -> [a]
:[]))
            [ Identifier
aboutIdent
            ]
    (Pattern -> PageConfReader Rules ())
-> [Pattern] -> PageConfReader Rules ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ([Char] -> Pattern -> PageConfReader Rules ()
mdRule [Char]
disneyExperienceSummarySnapshot) [Pattern]
items
    FontAwesomeIcons
faIcons <- (PageConf -> FontAwesomeIcons)
-> ReaderT PageConf Rules FontAwesomeIcons
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks PageConf -> FontAwesomeIcons
pcFaIcons
    Bool
isPreview <- (PageConf -> Bool) -> ReaderT PageConf Rules Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks PageConf -> Bool
pcIsPreview
    Dependency
disneyConfigDependency <- Rules Dependency -> ReaderT PageConf Rules Dependency
forall (m :: * -> *) a. Monad m => m a -> ReaderT PageConf m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Rules Dependency -> ReaderT PageConf Rules Dependency)
-> Rules Dependency -> ReaderT PageConf Rules Dependency
forall a b. (a -> b) -> a -> b
$ Pattern -> Rules Dependency
forall (m :: * -> *). MonadMetadata m => Pattern -> m Dependency
makePatternDependency Pattern
disneyConfigPath
    Rules () -> PageConfReader Rules ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT PageConf m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Rules () -> PageConfReader Rules ())
-> Rules () -> PageConfReader Rules ()
forall a b. (a -> b) -> a -> b
$ do
        Pattern -> Rules () -> Rules ()
match Pattern
disneyConfigPath (Rules () -> Rules ()) -> Rules () -> Rules ()
forall a b. (a -> b) -> a -> b
$ Compiler (Item [Char]) -> Rules ()
forall a.
(Binary a, Typeable a, Writable a) =>
Compiler (Item a) -> Rules ()
compile Compiler (Item [Char])
getResourceBody
        -- フォントファイルのコピー
        Pattern -> Rules () -> Rules ()
match ([Char] -> Pattern
fromGlob ([Char] -> Pattern) -> [Char] -> Pattern
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
joinPath [[Char]
contentsRoot, [Char]
"fonts", [Char]
"*.otf"]) (Rules () -> Rules ()) -> Rules () -> Rules ()
forall a b. (a -> b) -> a -> b
$ do
            Routes -> Rules ()
route (Routes -> Rules ()) -> Routes -> Rules ()
forall a b. (a -> b) -> a -> b
$ [Char] -> ShowS -> Routes
gsubRoute [Char]
"contents/" (ShowS -> Routes) -> ShowS -> Routes
forall a b. (a -> b) -> a -> b
$ [Char] -> ShowS
forall a b. a -> b -> a
const [Char]
""
            Compiler (Item CopyFile) -> Rules ()
forall a.
(Binary a, Typeable a, Writable a) =>
Compiler (Item a) -> Rules ()
compile Compiler (Item CopyFile)
copyFileCompiler

        -- Disney体験録に紐づく画像などのアセットをコピー
        Pattern -> Rules () -> Rules ()
match (([Char] -> Pattern
fromGlob ([Char] -> Pattern) -> [Char] -> Pattern
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
joinPath [[Char]
disneyExperienceSummaryRoot, [Char]
"logs", [Char]
"**"]) Pattern -> Pattern -> Pattern
.&&. Pattern -> Pattern
complement Pattern
disneyLogsPattern) (Rules () -> Rules ()) -> Rules () -> Rules ()
forall a b. (a -> b) -> a -> b
$ do
            Routes -> Rules ()
route (Routes -> Rules ()) -> Routes -> Rules ()
forall a b. (a -> b) -> a -> b
$ [Char] -> ShowS -> Routes
gsubRoute [Char]
"contents/" (ShowS -> Routes) -> ShowS -> Routes
forall a b. (a -> b) -> a -> b
$ [Char] -> ShowS
forall a b. a -> b -> a
const [Char]
""
            Compiler (Item CopyFile) -> Rules ()
forall a.
(Binary a, Typeable a, Writable a) =>
Compiler (Item a) -> Rules ()
compile Compiler (Item CopyFile)
copyFileCompiler

        -- JSON可視化データの生成
        [Identifier] -> Rules () -> Rules ()
create [[Char] -> Identifier
fromFilePath [Char]
"data/disney-experience-visualization.json"] (Rules () -> Rules ()) -> Rules () -> Rules ()
forall a b. (a -> b) -> a -> b
$ do
            Routes -> Rules ()
route Routes
idRoute
            Compiler (Item ByteString) -> Rules ()
forall a.
(Binary a, Typeable a, Writable a) =>
Compiler (Item a) -> Rules ()
compile (Compiler (Item ByteString) -> Rules ())
-> Compiler (Item ByteString) -> Rules ()
forall a b. (a -> b) -> a -> b
$ do
                [Item [Char]]
disneyLogs <- Pattern -> [Char] -> Compiler [Item [Char]]
forall a.
(Binary a, Typeable a) =>
Pattern -> [Char] -> Compiler [Item a]
loadAllSnapshots Pattern
disneyLogsPattern [Char]
disneyExperienceSummarySnapshot :: Compiler [Item String]
                VisualizationData
vizData <- [Item [Char]] -> Compiler VisualizationData
forall a. [Item a] -> Compiler VisualizationData
generateVisualizationData [Item [Char]]
disneyLogs
                ByteString -> Compiler (Item ByteString)
forall a. a -> Compiler (Item a)
makeItem (ByteString -> Compiler (Item ByteString))
-> ByteString -> Compiler (Item ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BL.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ VisualizationData -> ByteString
forall a. ToJSON a => a -> ByteString
encode VisualizationData
vizData

        [Dependency] -> Rules () -> Rules ()
forall a. [Dependency] -> Rules a -> Rules a
rulesExtraDependencies [Dependency
disneyConfigDependency] (Rules () -> Rules ()) -> Rules () -> Rules ()
forall a b. (a -> b) -> a -> b
$
            Pattern -> Rules () -> Rules ()
match Pattern
disneyExperienceSummaryJPPath (Rules () -> Rules ()) -> Rules () -> Rules ()
forall a b. (a -> b) -> a -> b
$ do
                Routes -> Rules ()
route (Routes -> Rules ()) -> Routes -> Rules ()
forall a b. (a -> b) -> a -> b
$ [Char] -> ShowS -> Routes
gsubRoute ([Char]
contentsRoot [Char] -> ShowS
</> [Char]
"pages/") ([Char] -> ShowS
forall a b. a -> b -> a
const [Char]
forall a. Monoid a => a
mempty)
                Compiler (Item [Char]) -> Rules ()
forall a.
(Binary a, Typeable a, Writable a) =>
Compiler (Item a) -> Rules ()
compile (Compiler (Item [Char]) -> Rules ())
-> Compiler (Item [Char]) -> Rules ()
forall a b. (a -> b) -> a -> b
$ do
                    [Favorite]
favorites <- IO [Favorite] -> Compiler [Favorite]
forall a. IO a -> Compiler a
unsafeCompiler IO [Favorite]
loadDisneyFavorites
                    [Hotel]
hotels <- IO [Hotel] -> Compiler [Hotel]
forall a. IO a -> Compiler a
unsafeCompiler IO [Hotel]
loadDisneyHotels
                    [Char]
hotelsLastModified <- IO [Char] -> Compiler [Char]
forall a. IO a -> Compiler a
unsafeCompiler IO [Char]
getHotelsLastModified
                    [Char]
logsLastModified <- IO [Char] -> Compiler [Char]
forall a. IO a -> Compiler a
unsafeCompiler IO [Char]
getLogsLastModified
                    Map [Char] ([Char], [Char])
tagConfig <- IO (Map [Char] ([Char], [Char]))
-> Compiler (Map [Char] ([Char], [Char]))
forall a. IO a -> Compiler a
unsafeCompiler IO (Map [Char] ([Char], [Char]))
tagConfigMap
                    [Item [Char]]
disneyLogs <- [Item [Char]] -> [Item [Char]]
forall a. [Item a] -> [Item a]
sortByNum ([Item [Char]] -> [Item [Char]])
-> Compiler [Item [Char]] -> Compiler [Item [Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern -> [Char] -> Compiler [Item [Char]]
forall a.
(Binary a, Typeable a) =>
Pattern -> [Char] -> Compiler [Item a]
loadAllSnapshots Pattern
disneyLogsPattern [Char]
disneyExperienceSummarySnapshot
                    let totalStays :: Natural
totalStays = [Natural] -> Natural
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Natural] -> Natural) -> [Natural] -> Natural
forall a b. (a -> b) -> a -> b
$ (Hotel -> Natural) -> [Hotel] -> [Natural]
forall a b. (a -> b) -> [a] -> [b]
map Hotel -> Natural
stays [Hotel]
hotels
                    let totalLogs :: Int
totalLogs = [Item [Char]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Item [Char]]
disneyLogs
                    -- ユニークなタグリストを作成
                    [[Char]]
uniqueTags <- do
                        [[[Char]]]
allTags <- [Compiler [[Char]]] -> Compiler [[[Char]]]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ([Compiler [[Char]]] -> Compiler [[[Char]]])
-> [Compiler [[Char]]] -> Compiler [[[Char]]]
forall a b. (a -> b) -> a -> b
$ (Item [Char] -> Compiler [[Char]])
-> [Item [Char]] -> [Compiler [[Char]]]
forall a b. (a -> b) -> [a] -> [b]
map (\Item [Char]
logItem -> do
                            Maybe [Char]
mTags <- Identifier -> [Char] -> Compiler (Maybe [Char])
forall (m :: * -> *).
MonadMetadata m =>
Identifier -> [Char] -> m (Maybe [Char])
getMetadataField (Item [Char] -> Identifier
forall a. Item a -> Identifier
itemIdentifier Item [Char]
logItem) [Char]
"disney-tags"
                            case Maybe [Char]
mTags of
                                Just [Char]
tagsStr -> [[Char]] -> Compiler [[Char]]
forall a. a -> Compiler a
forall (m :: * -> *) a. Monad m => a -> m a
return ([[Char]] -> Compiler [[Char]]) -> [[Char]] -> Compiler [[Char]]
forall a b. (a -> b) -> a -> b
$ ShowS -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ShowS
trimMeta ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ ([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> ([Char] -> Bool) -> [Char] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> [[Char]]
splitAll [Char]
"," [Char]
tagsStr
                                Maybe [Char]
Nothing      -> [[Char]] -> Compiler [[Char]]
forall a. a -> Compiler a
forall (m :: * -> *) a. Monad m => a -> m a
return []
                            ) [Item [Char]]
disneyLogs
                        [[Char]] -> Compiler [[Char]]
forall a. a -> Compiler a
forall (m :: * -> *) a. Monad m => a -> m a
return ([[Char]] -> Compiler [[Char]]) -> [[Char]] -> Compiler [[Char]]
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [[Char]]
forall a. Ord a => [a] -> [a]
sort ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [[Char]]
forall a. Eq a => [a] -> [a]
nub ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ [[[Char]]] -> [[Char]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[[Char]]]
allTags

                    Context [Char]
disneyExperienceSummaryCtx <- [Compiler (Context [Char])] -> Compiler (Context [Char])
forall (m :: * -> *) b. (Monad m, Monoid b) => [m b] -> m b
mconcatM [
                        Context [Char] -> Compiler (Context [Char])
forall a. a -> Compiler a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Context [Char] -> Compiler (Context [Char]))
-> Context [Char] -> Compiler (Context [Char])
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> Context [Char]
forall a. [Char] -> [Char] -> Context a
constField [Char]
"title" [Char]
"Ponchi's Disney Journey"
                      , Context [Char] -> Compiler (Context [Char])
forall a. a -> Compiler a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Context [Char] -> Compiler (Context [Char]))
-> Context [Char] -> Compiler (Context [Char])
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> Context [Char]
forall a. [Char] -> [Char] -> Context a
constField [Char]
"font_path" [Char]
"../fonts/waltograph42.otf"
                      , Context [Char] -> Compiler (Context [Char])
forall a. a -> Compiler a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Context [Char] -> Compiler (Context [Char]))
-> Context [Char] -> Compiler (Context [Char])
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> Context [Char]
forall a. [Char] -> [Char] -> Context a
constField [Char]
"is_preview" (Bool -> [Char]
forall a. Show a => a -> [Char]
show Bool
isPreview)
                      , Context [Char] -> Compiler (Context [Char])
forall a. a -> Compiler a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Context [Char] -> Compiler (Context [Char]))
-> Context [Char] -> Compiler (Context [Char])
forall a b. (a -> b) -> a -> b
$ [Char]
-> Context [Char] -> Compiler [Item [Char]] -> Context [Char]
forall a b. [Char] -> Context a -> Compiler [Item a] -> Context b
listField [Char]
"additional-css" ([Char] -> (Item [Char] -> Compiler [Char]) -> Context [Char]
forall a. [Char] -> (Item a -> Compiler [Char]) -> Context a
field [Char]
"css" ([Char] -> Compiler [Char]
forall a. a -> Compiler a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> Compiler [Char])
-> (Item [Char] -> [Char]) -> Item [Char] -> Compiler [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Item [Char] -> [Char]
forall a. Item a -> a
itemBody)) ([Item [Char]] -> Compiler [Item [Char]]
forall a. a -> Compiler a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Item [Char]] -> Compiler [Item [Char]])
-> [Item [Char]] -> Compiler [Item [Char]]
forall a b. (a -> b) -> a -> b
$ ([Char] -> Item [Char]) -> [[Char]] -> [Item [Char]]
forall a b. (a -> b) -> [a] -> [b]
map (\[Char]
css -> Identifier -> [Char] -> Item [Char]
forall a. Identifier -> a -> Item a
Item ([Char] -> Identifier
forall a. IsString a => [Char] -> a
fromString [Char]
css) [Char]
css) [[Char]
"../style/disney_experience_summary_only.css"])
                     , Context [Char] -> Compiler (Context [Char])
forall a. a -> Compiler a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Context [Char] -> Compiler (Context [Char]))
-> Context [Char] -> Compiler (Context [Char])
forall a b. (a -> b) -> a -> b
$ [Char]
-> Context [Char] -> Compiler [Item [Char]] -> Context [Char]
forall a b. [Char] -> Context a -> Compiler [Item a] -> Context b
listField [Char]
"additional-js" ([Char] -> (Item [Char] -> Compiler [Char]) -> Context [Char]
forall a. [Char] -> (Item a -> Compiler [Char]) -> Context a
field [Char]
"js" ([Char] -> Compiler [Char]
forall a. a -> Compiler a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> Compiler [Char])
-> (Item [Char] -> [Char]) -> Item [Char] -> Compiler [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Item [Char] -> [Char]
forall a. Item a -> a
itemBody)) ([Item [Char]] -> Compiler [Item [Char]]
forall a. a -> Compiler a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Item [Char]] -> Compiler [Item [Char]])
-> [Item [Char]] -> Compiler [Item [Char]]
forall a b. (a -> b) -> a -> b
$ ([Char] -> Item [Char]) -> [[Char]] -> [Item [Char]]
forall a b. (a -> b) -> [a] -> [b]
map (\[Char]
js -> Identifier -> [Char] -> Item [Char]
forall a. Identifier -> a -> Item a
Item ([Char] -> Identifier
forall a. IsString a => [Char] -> a
fromString [Char]
js) [Char]
js) [[Char]
"https://d3js.org/d3.v7.min.js", [Char]
"../js/disney-tag-filter.js", [Char]
"../js/disney-experience-visualizations.js"])
                      , Context [Char] -> Compiler (Context [Char])
forall a. a -> Compiler a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Context [Char]
siteCtx
                      , Context [Char] -> Compiler (Context [Char])
forall a. a -> Compiler a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Context [Char]
defaultContext
                      , [Char] -> [Char] -> Context [Char]
forall a. [Char] -> [Char] -> Context a
constField [Char]
"about-body"
                            ([Char] -> Context [Char])
-> Compiler [Char] -> Compiler (Context [Char])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Identifier -> [Char] -> Compiler [Char]
forall a.
(Binary a, Typeable a) =>
Identifier -> [Char] -> Compiler a
loadSnapshotBody Identifier
aboutIdent [Char]
disneyExperienceSummarySnapshot
                      , Context [Char] -> Compiler (Context [Char])
forall a. a -> Compiler a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Context [Char] -> Compiler (Context [Char]))
-> Context [Char] -> Compiler (Context [Char])
forall a b. (a -> b) -> a -> b
$ [Char]
-> Context [Char] -> Compiler [Item [Char]] -> Context [Char]
forall a b. [Char] -> Context a -> Compiler [Item a] -> Context b
listField [Char]
"disney-logs" (Map [Char] ([Char], [Char]) -> Context [Char]
disneyLogCtx Map [Char] ([Char], [Char])
tagConfig) ([Item [Char]] -> Compiler [Item [Char]]
forall a. a -> Compiler a
forall (m :: * -> *) a. Monad m => a -> m a
return [Item [Char]]
disneyLogs)
                      , Context [Char] -> Compiler (Context [Char])
forall a. a -> Compiler a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Context [Char] -> Compiler (Context [Char]))
-> Context [Char] -> Compiler (Context [Char])
forall a b. (a -> b) -> a -> b
$ [Char]
-> Context [Char] -> Compiler [Item [Char]] -> Context [Char]
forall a b. [Char] -> Context a -> Compiler [Item a] -> Context b
listField [Char]
"unique-tags" ([Char] -> (Item [Char] -> Compiler [Char]) -> Context [Char]
forall a. [Char] -> (Item a -> Compiler [Char]) -> Context a
field [Char]
"name" ([Char] -> Compiler [Char]
forall a. a -> Compiler a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> Compiler [Char])
-> (Item [Char] -> [Char]) -> Item [Char] -> Compiler [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Item [Char] -> [Char]
forall a. Item a -> a
itemBody) Context [Char] -> Context [Char] -> Context [Char]
forall a. Semigroup a => a -> a -> a
<> [Char] -> (Item [Char] -> Compiler [Char]) -> Context [Char]
forall a. [Char] -> (Item a -> Compiler [Char]) -> Context a
field [Char]
"color" ([Char] -> Compiler [Char]
forall a. a -> Compiler a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> Compiler [Char])
-> (Item [Char] -> [Char]) -> Item [Char] -> Compiler [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> Map [Char] ([Char], [Char]) -> [Char])
-> Map [Char] ([Char], [Char]) -> ShowS
forall a b c. (a -> b -> c) -> b -> a -> c
flip [Char] -> Map [Char] ([Char], [Char]) -> [Char]
getTagColor Map [Char] ([Char], [Char])
tagConfig ShowS -> (Item [Char] -> [Char]) -> Item [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Item [Char] -> [Char]
forall a. Item a -> a
itemBody) Context [Char] -> Context [Char] -> Context [Char]
forall a. Semigroup a => a -> a -> a
<> [Char] -> (Item [Char] -> Compiler [Char]) -> Context [Char]
forall a. [Char] -> (Item a -> Compiler [Char]) -> Context a
field [Char]
"link" ([Char] -> Compiler [Char]
forall a. a -> Compiler a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> Compiler [Char])
-> (Item [Char] -> [Char]) -> Item [Char] -> Compiler [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> Map [Char] ([Char], [Char]) -> [Char])
-> Map [Char] ([Char], [Char]) -> ShowS
forall a b c. (a -> b -> c) -> b -> a -> c
flip [Char] -> Map [Char] ([Char], [Char]) -> [Char]
getTagLink Map [Char] ([Char], [Char])
tagConfig ShowS -> (Item [Char] -> [Char]) -> Item [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Item [Char] -> [Char]
forall a. Item a -> a
itemBody)) ([Item [Char]] -> Compiler [Item [Char]]
forall a. a -> Compiler a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Item [Char]] -> Compiler [Item [Char]])
-> [Item [Char]] -> Compiler [Item [Char]]
forall a b. (a -> b) -> a -> b
$ ([Char] -> Item [Char]) -> [[Char]] -> [Item [Char]]
forall a b. (a -> b) -> [a] -> [b]
map (\[Char]
tag -> Identifier -> [Char] -> Item [Char]
forall a. Identifier -> a -> Item a
Item ([Char] -> Identifier
forall a. IsString a => [Char] -> a
fromString [Char]
tag) [Char]
tag) [[Char]]
uniqueTags)
                      , Context [Char] -> Compiler (Context [Char])
forall a. a -> Compiler a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Context [Char] -> Compiler (Context [Char]))
-> Context [Char] -> Compiler (Context [Char])
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> [Favorite] -> Context [Char]
favoritesListField [Char]
"favorite-works" [Char]
"works" [Favorite]
favorites
                      , Context [Char] -> Compiler (Context [Char])
forall a. a -> Compiler a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Context [Char] -> Compiler (Context [Char]))
-> Context [Char] -> Compiler (Context [Char])
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> [Favorite] -> Context [Char]
favoritesListField [Char]
"favorite-characters" [Char]
"characters" [Favorite]
favorites
                      , Context [Char] -> Compiler (Context [Char])
forall a. a -> Compiler a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Context [Char] -> Compiler (Context [Char]))
-> Context [Char] -> Compiler (Context [Char])
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> [Favorite] -> Context [Char]
favoritesListField [Char]
"favorite-park-contents" [Char]
"park-contents" [Favorite]
favorites
                      , Context [Char] -> Compiler (Context [Char])
forall a. a -> Compiler a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Context [Char] -> Compiler (Context [Char]))
-> Context [Char] -> Compiler (Context [Char])
forall a b. (a -> b) -> a -> b
$ [Char] -> Context Hotel -> Compiler [Item Hotel] -> Context [Char]
forall a b. [Char] -> Context a -> Compiler [Item a] -> Context b
listField [Char]
"hotel-stays" Context Hotel
hotelCtx ([Item Hotel] -> Compiler [Item Hotel]
forall a. a -> Compiler a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Item Hotel] -> Compiler [Item Hotel])
-> [Item Hotel] -> Compiler [Item Hotel]
forall a b. (a -> b) -> a -> b
$ (Hotel -> Item Hotel) -> [Hotel] -> [Item Hotel]
forall a b. (a -> b) -> [a] -> [b]
map (\Hotel
h -> Identifier -> Hotel -> Item Hotel
forall a. Identifier -> a -> Item a
Item ([Char] -> Identifier
forall a. IsString a => [Char] -> a
fromString ([Char] -> Identifier) -> [Char] -> Identifier
forall a b. (a -> b) -> a -> b
$ Hotel -> [Char]
hotelCode Hotel
h) Hotel
h) [Hotel]
hotels)
                      , Context [Char] -> Compiler (Context [Char])
forall a. a -> Compiler a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Context [Char] -> Compiler (Context [Char]))
-> Context [Char] -> Compiler (Context [Char])
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> Context [Char]
forall a. [Char] -> [Char] -> Context a
constField [Char]
"hotels-last-modified" [Char]
hotelsLastModified
                      , Context [Char] -> Compiler (Context [Char])
forall a. a -> Compiler a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Context [Char] -> Compiler (Context [Char]))
-> Context [Char] -> Compiler (Context [Char])
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> Context [Char]
forall a. [Char] -> [Char] -> Context a
constField [Char]
"hotels-total-stays" (Natural -> [Char]
forall a. Show a => a -> [Char]
show Natural
totalStays)
                      , Context [Char] -> Compiler (Context [Char])
forall a. a -> Compiler a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Context [Char] -> Compiler (Context [Char]))
-> Context [Char] -> Compiler (Context [Char])
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> Context [Char]
forall a. [Char] -> [Char] -> Context a
constField [Char]
"logs-total-count" (Int -> [Char]
forall a. Show a => a -> [Char]
show Int
totalLogs)
                      , Context [Char] -> Compiler (Context [Char])
forall a. a -> Compiler a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Context [Char] -> Compiler (Context [Char]))
-> Context [Char] -> Compiler (Context [Char])
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> Context [Char]
forall a. [Char] -> [Char] -> Context a
constField [Char]
"logs-last-modified" [Char]
logsLastModified
                          ]
                    Compiler (Item [Char])
getResourceBody
                        Compiler (Item [Char]) -> KaTeXRender -> Compiler (Item [Char])
forall a b. Compiler a -> (a -> Compiler b) -> Compiler b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Context [Char] -> KaTeXRender
applyAsTemplate Context [Char]
disneyExperienceSummaryCtx
                        Compiler (Item [Char]) -> KaTeXRender -> Compiler (Item [Char])
forall a b. Compiler a -> (a -> Compiler b) -> Compiler b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Identifier -> Context [Char] -> KaTeXRender
forall a.
Identifier -> Context a -> Item a -> Compiler (Item [Char])
loadAndApplyTemplate Identifier
rootTemplate Context [Char]
disneyExperienceSummaryCtx
                        Compiler (Item [Char]) -> KaTeXRender -> Compiler (Item [Char])
forall a b. Compiler a -> (a -> Compiler b) -> Compiler b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= KaTeXRender
relativizeUrls
                        Compiler (Item [Char]) -> KaTeXRender -> Compiler (Item [Char])
forall a b. Compiler a -> (a -> Compiler b) -> Compiler b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FontAwesomeIcons -> KaTeXRender
FA.render FontAwesomeIcons
faIcons

        [(Identifier, [Char])] -> Rules ()
createRedirects [
            ([Char] -> Identifier
fromFilePath ([Char] -> Identifier) -> [Char] -> Identifier
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
joinPath [[Char]
"disney_experience_summary", [Char]
"index.html"], [[Char]] -> [Char]
joinPath [[Char]
"/", [Char]
"disney_experience_summary", [Char]
"jp.html"]),
            ([Char] -> Identifier
fromFilePath ([Char] -> Identifier) -> [Char] -> Identifier
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
joinPath [[Char]
"disney", [Char]
"index.html"], [[Char]] -> [Char]
joinPath [[Char]
"/", [Char]
"disney_experience_summary", [Char]
"jp.html"])
          ]
    where
        disneyExperienceSummarySnapshot :: [Char]
disneyExperienceSummarySnapshot = [Char]
"disneyExperienceSummarySS"
        disneyConfigPath :: Pattern
disneyConfigPath = [Char] -> Pattern
fromRegex [Char]
"^contents/config/disney/.+\\.dhall$"
        disneyExperienceSummaryJPPath :: Pattern
disneyExperienceSummaryJPPath = [Char] -> Pattern
fromGlob ([Char] -> Pattern) -> [Char] -> Pattern
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
joinPath [[Char]
contentsRoot, [Char]
"pages", [Char]
"disney_experience_summary", [Char]
"jp.html"]
        rootTemplate :: Identifier
rootTemplate = [Char] -> Identifier
fromFilePath ([Char] -> Identifier) -> [Char] -> Identifier
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
joinPath [[Char]
contentsRoot, [Char]
"templates", [Char]
"site", [Char]
"default.html"]

        favoritesListField :: String -> String -> [Favorite] -> Context String
        favoritesListField :: [Char] -> [Char] -> [Favorite] -> Context [Char]
favoritesListField [Char]
fieldName [Char]
categoryName [Favorite]
favs =
            [Char]
-> Context Favorite -> Compiler [Item Favorite] -> Context [Char]
forall a b. [Char] -> Context a -> Compiler [Item a] -> Context b
listField [Char]
fieldName Context Favorite
favoritesCtx (Compiler [Item Favorite] -> Context [Char])
-> Compiler [Item Favorite] -> Context [Char]
forall a b. (a -> b) -> a -> b
$ [Item Favorite] -> Compiler [Item Favorite]
forall a. a -> Compiler a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Item Favorite] -> Compiler [Item Favorite])
-> [Item Favorite] -> Compiler [Item Favorite]
forall a b. (a -> b) -> a -> b
$ [Char] -> [Favorite] -> [Item Favorite]
favoriteItems [Char]
categoryName [Favorite]
favs

        favoritesCtx :: Context Favorite
        favoritesCtx :: Context Favorite
favoritesCtx = [Char] -> (Item Favorite -> Compiler [Char]) -> Context Favorite
forall a. [Char] -> (Item a -> Compiler [Char]) -> Context a
field [Char]
"text" ([Char] -> Compiler [Char]
forall a. a -> Compiler a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> Compiler [Char])
-> (Item Favorite -> [Char]) -> Item Favorite -> Compiler [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Favorite -> [Char]
text (Favorite -> [Char])
-> (Item Favorite -> Favorite) -> Item Favorite -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Item Favorite -> Favorite
forall a. Item a -> a
itemBody)
            Context Favorite -> Context Favorite -> Context Favorite
forall a. Semigroup a => a -> a -> a
<> [Char] -> (Item Favorite -> Compiler [Char]) -> Context Favorite
forall a. [Char] -> (Item a -> Compiler [Char]) -> Context a
field [Char]
"link" ([Char] -> Compiler [Char]
forall a. a -> Compiler a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> Compiler [Char])
-> (Item Favorite -> [Char]) -> Item Favorite -> Compiler [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS -> Maybe [Char] -> [Char]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
"" ShowS
forall a. a -> a
id (Maybe [Char] -> [Char])
-> (Item Favorite -> Maybe [Char]) -> Item Favorite -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Favorite -> Maybe [Char]
link (Favorite -> Maybe [Char])
-> (Item Favorite -> Favorite) -> Item Favorite -> Maybe [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Item Favorite -> Favorite
forall a. Item a -> a
itemBody)

        favoriteItems :: String -> [Favorite] -> [Item Favorite]
        favoriteItems :: [Char] -> [Favorite] -> [Item Favorite]
favoriteItems [Char]
categoryName [Favorite]
favs =
            (Favorite -> Item Favorite) -> [Favorite] -> [Item Favorite]
forall a b. (a -> b) -> [a] -> [b]
map (\Favorite
f -> Identifier -> Favorite -> Item Favorite
forall a. Identifier -> a -> Item a
Item ([Char] -> Identifier
forall a. IsString a => [Char] -> a
fromString ([Char] -> Identifier) -> [Char] -> Identifier
forall a b. (a -> b) -> a -> b
$ Favorite -> [Char]
text Favorite
f) Favorite
f)
                ([Favorite] -> [Item Favorite]) -> [Favorite] -> [Item Favorite]
forall a b. (a -> b) -> a -> b
$ (Favorite -> [Char]) -> [Favorite] -> [Favorite]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn Favorite -> [Char]
text
                ([Favorite] -> [Favorite]) -> [Favorite] -> [Favorite]
forall a b. (a -> b) -> a -> b
$ (Favorite -> Bool) -> [Favorite] -> [Favorite]
forall a. (a -> Bool) -> [a] -> [a]
filter (([Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
categoryName) ([Char] -> Bool) -> (Favorite -> [Char]) -> Favorite -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Favorite -> [Char]
category) [Favorite]
favs