72 lines
2.7 KiB
Haskell
72 lines
2.7 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.Lazy as LBS
|
|
import qualified Data.ByteString.UTF8 as BS.UTF8
|
|
import Data.ByteString (ByteString)
|
|
import Data.List.Split (splitOn)
|
|
import qualified Data.Aeson as JSON
|
|
import Data.Aeson ((.:))
|
|
import Data.Aeson.Types (FromJSON)
|
|
import qualified Data.Map as Map
|
|
import Data.Map (Map)
|
|
|
|
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 = parseSplit . splitOn "\\\\\\\\$" . BS.UTF8.toString
|
|
where parseSplit :: [String] -> [PageTemplatePart]
|
|
parseSplit [] = []
|
|
parseSplit [part] = [PTString $ BS.UTF8.fromString part]
|
|
parseSplit (first:rest) = PTString (BS.UTF8.fromString first) : concatMap parseSegment rest
|
|
|
|
parseSegment :: String -> [PageTemplatePart]
|
|
parseSegment segment =
|
|
let (numStr, next) = break (== '$') segment
|
|
(templatePart, rawPart) = splitAt (read numStr) (drop 1 next)
|
|
in [parseTemplate $ BS.UTF8.fromString templatePart, PTString $ BS.UTF8.fromString rawPart]
|
|
|
|
parseTemplate :: ByteString -> PageTemplatePart
|
|
parseTemplate = parseTemplate' . JSON.decode . LBS.fromStrict
|
|
--parseTemplate v = PTString $ BS.UTF8.fromString $ "[-" ++ BS.UTF8.toString v ++ "-]"
|
|
|
|
parseTemplate' :: Maybe JsonTemplate -> PageTemplatePart
|
|
parseTemplate' Nothing = PTString "{parse error}"
|
|
parseTemplate' (Just jt) = PTComputed $ jsonTemplateFn jt
|
|
|
|
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.UTF8.fromString $ viewStr $ Map.lookup page pageviews
|
|
where viewStr Nothing = "{unk}"
|
|
viewStr (Just viewcount) = show viewcount
|