From ba38e5e66eaba54a4142019dea63b8348d599747 Mon Sep 17 00:00:00 2001 From: outfoxxed Date: Mon, 10 Feb 2025 21:31:20 -0800 Subject: [PATCH] rewrite parsePage to use only ByteStrings --- src/TemplatePage.hs | 37 ++++++++++++++++--------------------- 1 file changed, 16 insertions(+), 21 deletions(-) diff --git a/src/TemplatePage.hs b/src/TemplatePage.hs index 45ce76d..d01475c 100644 --- a/src/TemplatePage.hs +++ b/src/TemplatePage.hs @@ -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