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

import           Control.Monad.Reader  (asks)
import           Control.Monad.Trans   (MonadTrans (..))
import           Data.List             (foldl', nub, sort, sortBy)
import qualified Data.Map              as M
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      (getModificationTime, listDirectory)
import           System.FilePath       (joinPath, (</>))
import           System.FilePath.Posix (takeBaseName)

import           Config                (contentsRoot, readerOptions)
import           Contexts              (siteCtx)
import           Media.SVG             (mermaidTransform)
import           Rules.PageType
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

-- 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))

-- 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]
"$)"
    ]

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
$ ([Char] -> Int
forall a. Read a => [Char] -> a
read :: String -> Int) ([Char] -> Int) -> (Item a -> [Char]) -> Item a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
takeBaseName ShowS -> (Item a -> [Char]) -> Item a -> [Char]
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

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]]
files <- [Char] -> IO [[Char]]
listDirectory [Char]
logsDir
    let mdFiles :: [[Char]]
mdFiles = ([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter (\[Char]
f -> [Char]
".md" [Char] -> [Char] -> Bool
forall {a}. Eq a => [a] -> [a] -> Bool
`isSuffixOf` [Char]
f) [[Char]]
files
    [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]
f -> [Char] -> IO UTCTime
getModificationTime ([Char]
logsDir [Char] -> ShowS
</> [Char]
f)) [[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
  where
    isSuffixOf :: [a] -> [a] -> Bool
isSuffixOf [a]
suffix [a]
str = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop ([a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
str Int -> Int -> Int
forall a. Num a => a -> a -> a
- [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
suffix) [a]
str [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
== [a]
suffix

-- ログエントリ用のコンテキストを作成
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] -> Context [Char]
snsLinksField [Char]
"youtube"
    , [Char] -> Context [Char]
snsLinksField [Char]
"instagram"
    , [Char] -> Context [Char]
snsLinksField [Char]
"x"
    , [Char] -> Context [Char]
snsLinksField [Char]
"note"
    , Map [Char] ([Char], [Char]) -> Context [Char]
disneyTagsField Map [Char] ([Char], [Char])
tagConfig
    , Context [Char]
forall a. Context a
aiGeneratedField
    ]
  where
    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" ([Char] -> (Item [Char] -> Compiler [Char]) -> Context [Char]
forall a. [Char] -> (Item a -> Compiler [Char]) -> Context a
field [Char]
"badge-text" ([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 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]
mAiGenerated <- 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"
        case Maybe [Char]
mAiGenerated of
            Just [Char]
"true" -> [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]
"Generated by AI"]
            Maybe [Char]
_           -> [Item [Char]] -> Compiler [Item [Char]]
forall a. a -> Compiler a
forall (m :: * -> *) a. Monad m => a -> m a
return []

-- ホテル情報用のコンテキストを作成
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
    [Favorite]
favorites <- Rules [Favorite] -> ReaderT PageConf Rules [Favorite]
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 [Favorite] -> ReaderT PageConf Rules [Favorite])
-> Rules [Favorite] -> ReaderT PageConf Rules [Favorite]
forall a b. (a -> b) -> a -> b
$ IO [Favorite] -> Rules [Favorite]
forall a. IO a -> Rules a
preprocess IO [Favorite]
loadDisneyFavorites
    [Hotel]
hotels <- Rules [Hotel] -> ReaderT PageConf Rules [Hotel]
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 [Hotel] -> ReaderT PageConf Rules [Hotel])
-> Rules [Hotel] -> ReaderT PageConf Rules [Hotel]
forall a b. (a -> b) -> a -> b
$ IO [Hotel] -> Rules [Hotel]
forall a. IO a -> Rules a
preprocess IO [Hotel]
loadDisneyHotels
    [Char]
hotelsLastModified <- Rules [Char] -> ReaderT PageConf Rules [Char]
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 [Char] -> ReaderT PageConf Rules [Char])
-> Rules [Char] -> ReaderT PageConf Rules [Char]
forall a b. (a -> b) -> a -> b
$ IO [Char] -> Rules [Char]
forall a. IO a -> Rules a
preprocess IO [Char]
getHotelsLastModified
    [Char]
logsLastModified <- Rules [Char] -> ReaderT PageConf Rules [Char]
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 [Char] -> ReaderT PageConf Rules [Char])
-> Rules [Char] -> ReaderT PageConf Rules [Char]
forall a b. (a -> b) -> a -> b
$ IO [Char] -> Rules [Char]
forall a. IO a -> Rules a
preprocess IO [Char]
getLogsLastModified
    Map [Char] ([Char], [Char])
tagConfig <- Rules (Map [Char] ([Char], [Char]))
-> ReaderT PageConf Rules (Map [Char] ([Char], [Char]))
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 (Map [Char] ([Char], [Char]))
 -> ReaderT PageConf Rules (Map [Char] ([Char], [Char])))
-> Rules (Map [Char] ([Char], [Char]))
-> ReaderT PageConf Rules (Map [Char] ([Char], [Char]))
forall a b. (a -> b) -> a -> b
$ IO (Map [Char] ([Char], [Char]))
-> Rules (Map [Char] ([Char], [Char]))
forall a. IO a -> Rules a
preprocess IO (Map [Char] ([Char], [Char]))
tagConfigMap
    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
    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 ([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

        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
                [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 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]
"../js/disney-tag-filter.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]
-> Context Favorite -> Compiler [Item Favorite] -> Context [Char]
forall a b. [Char] -> Context a -> Compiler [Item a] -> Context b
listField [Char]
"favorite-works" ([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)) ([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
$ (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 -> Bool) -> [Favorite] -> [Favorite]
forall a. (a -> Bool) -> [a] -> [a]
filter (([Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"works") ([Char] -> Bool) -> (Favorite -> [Char]) -> Favorite -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Favorite -> [Char]
category) [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 Favorite -> Compiler [Item Favorite] -> Context [Char]
forall a b. [Char] -> Context a -> Compiler [Item a] -> Context b
listField [Char]
"favorite-characters" ([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)) ([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
$ (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 -> Bool) -> [Favorite] -> [Favorite]
forall a. (a -> Bool) -> [a] -> [a]
filter (([Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"characters") ([Char] -> Bool) -> (Favorite -> [Char]) -> Favorite -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Favorite -> [Char]
category) [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 Favorite -> Compiler [Item Favorite] -> Context [Char]
forall a b. [Char] -> Context a -> Compiler [Item a] -> Context b
listField [Char]
"favorite-park-contents" ([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)) ([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
$ (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 -> Bool) -> [Favorite] -> [Favorite]
forall a. (a -> Bool) -> [a] -> [a]
filter (([Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"park-contents") ([Char] -> Bool) -> (Favorite -> [Char]) -> Favorite -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Favorite -> [Char]
category) [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
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

        [(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"
        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"]