outfoxxed/blog-proxy
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

rewrite parsePage to use only ByteStrings

Browse source
This commit is contained in:
outfoxxed 2025-02-10 21:31:20 -08:00
parent a60daddd0c
commit ba38e5e66e
Signed by: outfoxxed
GPG key ID: 4C88A185FB89301E
1 changed files with 16 additions and 21 deletions
Download patch file Download diff file Expand all files Collapse all files

37
src/TemplatePage.hs
View file

@ -11,15 +11,14 @@ module TemplatePage (
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 qualified Data.ByteString.Char8 as BS.Char8
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)
import Data.Bool (bool)
newtype PageContext = PageContext { ctxPageviews :: Map String Int }
@ -36,25 +35,21 @@ buildPage context template = BS.concat $ map handlePart template
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]
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 = 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
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)
@ -66,6 +61,6 @@ instance FromJSON JsonTemplate where
jsonTemplateFn :: JsonTemplate -> (PageContext -> ByteString)
jsonTemplateFn TViewCount { jtPage = page } PageContext { ctxPageviews = pageviews }
= BS.UTF8.fromString $ viewStr $ Map.lookup page pageviews
= BS.Char8.pack $ viewStr $ Map.lookup page pageviews
where viewStr Nothing = "{unk}"
viewStr (Just viewcount) = show viewcount