{-# 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)
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
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"
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))
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"
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
}
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
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"]