66 lines
2.6 KiB
Haskell
66 lines
2.6 KiB
Haskell
{-# LANGUAGE DeriveGeneric #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
module TemplatePage (
|
|
PageContext (PageContext, ctxPageviews),
|
|
PageTemplate,
|
|
parsePage,
|
|
buildPage,
|
|
isUntemplated,
|
|
) where
|
|
|
|
import GHC.Generics (Generic)
|
|
import qualified Data.ByteString as BS
|
|
import qualified Data.ByteString.Char8 as BS.Char8
|
|
import Data.ByteString (ByteString)
|
|
import qualified Data.Aeson as JSON
|
|
import Data.Aeson ((.:))
|
|
import Data.Aeson.Types (FromJSON)
|
|
import qualified Data.Map as Map
|
|
import Data.Map (Map)
|
|
import Data.Bool (bool)
|
|
|
|
newtype PageContext = PageContext { ctxPageviews :: Map String Int }
|
|
|
|
data PageTemplatePart = PTString !ByteString | PTComputed !(PageContext -> ByteString)
|
|
type PageTemplate = [PageTemplatePart]
|
|
|
|
isUntemplated :: PageTemplate -> Bool
|
|
isUntemplated [PTString _] = True
|
|
isUntemplated _ = False
|
|
|
|
buildPage :: PageContext -> PageTemplate -> ByteString
|
|
buildPage context template = BS.concat $ map handlePart template
|
|
where handlePart (PTString p) = p
|
|
handlePart (PTComputed p) = p context
|
|
|
|
parsePage :: ByteString -> PageTemplate
|
|
parsePage = parsePage' . BS.breakSubstring "\\\\\\\\$"
|
|
where parsePage' :: (ByteString, ByteString) -> PageTemplate
|
|
parsePage' (prematch, match)
|
|
| BS.null match = [PTString prematch]
|
|
| otherwise = let (lenStr, rest) = BS.breakSubstring "{" $ BS.drop 5 match
|
|
(templateStr, rest') = case BS.Char8.readInt lenStr of
|
|
Just (len, _) -> BS.splitAt len rest
|
|
Nothing -> (BS.empty, rest)
|
|
parsed = parseTemplate templateStr : parsePage rest'
|
|
in bool (PTString prematch : parsed) parsed $ BS.null prematch
|
|
|
|
parseTemplate :: ByteString -> PageTemplatePart
|
|
parseTemplate template = case JSON.decode $ BS.fromStrict template of
|
|
Nothing -> PTString $ BS.concat ["{parse error on `", template, "` }"]
|
|
Just json -> PTComputed $ jsonTemplateFn json
|
|
|
|
newtype JsonTemplate = TViewCount { jtPage :: String } deriving (Generic, Show)
|
|
|
|
instance FromJSON JsonTemplate where
|
|
parseJSON = JSON.withObject "JsonTemplate" $ \o -> o .: "t"
|
|
>>= \t -> case (t :: String) of
|
|
"pageviews" -> TViewCount <$> o .: "page"
|
|
other -> fail $ "Unexpected t: " ++ other
|
|
|
|
jsonTemplateFn :: JsonTemplate -> (PageContext -> ByteString)
|
|
jsonTemplateFn TViewCount { jtPage = page } PageContext { ctxPageviews = pageviews }
|
|
= BS.Char8.pack $ viewStr $ Map.lookup page pageviews
|
|
where viewStr Nothing = "{unk}"
|
|
viewStr (Just viewcount) = show viewcount
|