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 GHC.Generics (Generic)
import qualified Data.ByteString as BS import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LBS import qualified Data.ByteString.Char8 as BS.Char8
import qualified Data.ByteString.UTF8 as BS.UTF8
import Data.ByteString (ByteString) import Data.ByteString (ByteString)
import Data.List.Split (splitOn)
import qualified Data.Aeson as JSON import qualified Data.Aeson as JSON
import Data.Aeson ((.:)) import Data.Aeson ((.:))
import Data.Aeson.Types (FromJSON) import Data.Aeson.Types (FromJSON)
import qualified Data.Map as Map import qualified Data.Map as Map
import Data.Map (Map) import Data.Map (Map)
import Data.Bool (bool)
newtype PageContext = PageContext { ctxPageviews :: Map String Int } newtype PageContext = PageContext { ctxPageviews :: Map String Int }
@ -36,25 +35,21 @@ buildPage context template = BS.concat $ map handlePart template
handlePart (PTComputed p) = p context handlePart (PTComputed p) = p context
parsePage :: ByteString -> PageTemplate parsePage :: ByteString -> PageTemplate
parsePage = parseSplit . splitOn "\\\\\\\\$" . BS.UTF8.toString parsePage = parsePage' . BS.breakSubstring "\\\\\\\\$"
where parseSplit :: [String] -> [PageTemplatePart] where parsePage' :: (ByteString, ByteString) -> PageTemplate
parseSplit [] = [] parsePage' (prematch, match)
parseSplit [part] = [PTString $ BS.UTF8.fromString part] | BS.null match = [PTString prematch]
parseSplit (first:rest) = PTString (BS.UTF8.fromString first) : concatMap parseSegment rest | otherwise = let (lenStr, rest) = BS.breakSubstring "{" $ BS.drop 5 match
(templateStr, rest') = case BS.Char8.readInt lenStr of
parseSegment :: String -> [PageTemplatePart] Just (len, _) -> BS.splitAt len rest
parseSegment segment = Nothing -> (BS.empty, rest)
let (numStr, next) = break (== '$') segment parsed = parseTemplate templateStr : parsePage rest'
(templatePart, rawPart) = splitAt (read numStr) (drop 1 next) in bool (PTString prematch : parsed) parsed $ BS.null prematch
in [parseTemplate $ BS.UTF8.fromString templatePart, PTString $ BS.UTF8.fromString rawPart]
parseTemplate :: ByteString -> PageTemplatePart parseTemplate :: ByteString -> PageTemplatePart
parseTemplate = parseTemplate' . JSON.decode . LBS.fromStrict parseTemplate template = case JSON.decode $ BS.fromStrict template of
--parseTemplate v = PTString $ BS.UTF8.fromString $ "[-" ++ BS.UTF8.toString v ++ "-]" Nothing -> PTString $ BS.concat ["{parse error on `", template, "` }"]
Just json -> PTComputed $ jsonTemplateFn json
parseTemplate' :: Maybe JsonTemplate -> PageTemplatePart
parseTemplate' Nothing = PTString "{parse error}"
parseTemplate' (Just jt) = PTComputed $ jsonTemplateFn jt
newtype JsonTemplate = TViewCount { jtPage :: String } deriving (Generic, Show) newtype JsonTemplate = TViewCount { jtPage :: String } deriving (Generic, Show)
@ -66,6 +61,6 @@ instance FromJSON JsonTemplate where
jsonTemplateFn :: JsonTemplate -> (PageContext -> ByteString) jsonTemplateFn :: JsonTemplate -> (PageContext -> ByteString)
jsonTemplateFn TViewCount { jtPage = page } PageContext { ctxPageviews = pageviews } 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}" where viewStr Nothing = "{unk}"
viewStr (Just viewcount) = show viewcount viewStr (Just viewcount) = show viewcount