initial commit

src/TemplatePage.hs

@@ -0,0 +1,71 @@
+{-# 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