diff --git a/aoc-proxy.cabal b/aoc-proxy.cabal index 740566648189c141961c98d02d2dea3ec6d99435..de39a977cb12e3aa648a60d02c9de5f2d5699367 100644 --- a/aoc-proxy.cabal +++ b/aoc-proxy.cabal @@ -35,12 +35,16 @@ executable aoc-proxy split -any, hashable -any, parsec -any, + aeson -any, + yaml -any, + mtl -any, + utf8-string -any, directory -any, bytestring >=0.10.4, binary >=0.8.6.0, base -any, text -any, - blaze-html -any, + data-default -any, ginger >=0.10.4.0 hs-source-dirs: src default-language: Haskell2010 diff --git a/config.json b/config.json new file mode 100644 index 0000000000000000000000000000000000000000..62f699e2ea8dd66589e4c992e6464f174f9b8c27 --- /dev/null +++ b/config.json @@ -0,0 +1,5 @@ +{ + "hello": "world", + "yeet": "blue", + "yeet2": 12.3 +} diff --git a/src/Common.hs b/src/Common.hs index c5a8d4ec8ec350fe68dfa134a16e63939cb9cbe8..86feb9eb252a12ee9df21f6f791fe4c6999bfdfa 100644 --- a/src/Common.hs +++ b/src/Common.hs @@ -9,10 +9,11 @@ import System.IO (IOMode(ReadMode), openFile, hGetContents) import Data.List (zip, isPrefixOf) import Data.List.Split +import qualified Data.Aeson as JSON + filename :: FilePath -> FilePath filename fn = last (splitOn "/" fn) - getFile :: FilePath -> HashMap FilePath String -> Maybe String getFile fn dir = HashMap.lookup (filename fn) dir @@ -31,3 +32,5 @@ loadFile fn = do f <- openFile fn ReadMode hGetContents f + + diff --git a/src/Config.hs b/src/Config.hs index b83a9046a6ceae13c4069b35b76e33e7f3c11748..1cde085f097e7fce1eb4f8b86aed3ee65d8e1a85 100644 --- a/src/Config.hs +++ b/src/Config.hs @@ -15,4 +15,6 @@ templatesDir :: FilePath templatesDir = "templates" +configFile :: FilePath +configFile = "config.json" diff --git a/src/Main.hs b/src/Main.hs index 43cc569a45c938b281796e00227d674e1ee81fc0..a851327225b60310013cfd25f2b2f930d7517e1d 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-} +{-# LANGUAGE OverloadedStrings, ScopedTypeVariables, TypeApplications #-} module Main where @@ -12,10 +12,6 @@ import Data.Maybe (fromMaybe) import Data.Text (Text) import Data.Text.Lazy (unpack) import Happstack.Lite -import Text.Blaze.Html5 (Html, (!), a, form, input, p, toHtml, label) -import Text.Blaze.Html5.Attributes (action, enctype, href, name, size, type_, value) -import qualified Text.Blaze.Html5 as H -import qualified Text.Blaze.Html5.Attributes as A import Data.HashMap.Strict (fromList, HashMap) import qualified Data.HashMap.Strict as HashMap @@ -25,21 +21,44 @@ import Data.List (zip) import System.Exit (exitFailure) +import Text.Ginger +import Text.Ginger.GVal +import Text.Ginger.Html +import qualified Data.Aeson as JSON +import qualified Data.Yaml as YAML + +import qualified Data.ByteString.Lazy as B +import qualified Data.ByteString.Lazy.UTF8 as BLU +import Control.Monad.Writer + main :: IO () main = do putStrLn "===============================================================================" - -- Read Templates - rawTemplates <- readDir templatesDir - let templates = parseTemplates rawTemplates - case templates of + -- Read Config + configFileData <- loadFile configFile + let configJSON = JSON.eitherDecode (BLU.fromString configFileData) + case configJSON of Left errs -> do - putStrLn "Failed parsing templates:" - printParseErrors errs + putStrLn "Failed parsing config JSON:" + print errs exitFailure - Right templates' -> do + Right configJSON' -> do + let configGVal = rawJSONToGVal configJSON' + putStrLn ("Using config: " ++ (show configGVal)) + - -- Serve Files - putStrLn ("Hosting aoc-proxy on http://localhost:" ++ (show (port aocServerConfig)) ++ " ...") - serve (Just aocServerConfig) (routes templates') + -- Read Templates + rawTemplates <- readDir templatesDir + let templates = parseTemplates rawTemplates + case templates of + Left errs -> do + putStrLn "Failed parsing templates:" + printParseErrors errs + exitFailure + Right templates' -> do + + -- Serve Files + putStrLn ("Hosting aoc-proxy on http://localhost:" ++ (show (port aocServerConfig)) ++ " ...") + serve (Just aocServerConfig) (routes templates' configGVal) diff --git a/src/Routes.hs b/src/Routes.hs index 5e173a795ebfb14651f012a4d275a3138b9a05d4..c884b70460a9ce51c53ffb4b868d10ffeece21e1 100644 --- a/src/Routes.hs +++ b/src/Routes.hs @@ -16,23 +16,27 @@ import qualified Data.ByteString.Char8 as B import Text.Ginger.Html (Html, htmlSource) +import Data.Aeson (ToJSON) instance ToMessage Html where toContentType _ = B.pack "text/html; charset=UTF-8" toMessage = toMessage . htmlSource -routes :: Templates -> ServerPart Response -routes templates = msum [ +routes :: ToJSON c => Templates -> c -> ServerPart Response +routes templates context = msum [ dir "static" $ handlerFileServing - , handler templates "index.html" Nothing + , handler templates context "index.html" Nothing ] -handler :: Templates -> TemplateName -> Maybe (a -> ServerPart a) -> ServerPart Response -handler templates templateName extraHandlerMay = handler' (lookupTemplate templateName templates) extraHandlerMay +handler :: ToJSON c => Templates -> c -> TemplateName -> Maybe (a -> ServerPart a) -> ServerPart Response +handler templates context templateName extraHandlerMay = handler' (lookupTemplate templateName templates) extraHandlerMay where handler' Nothing _ = internalServerError (strToResponse "Template lookup failed.") handler' (Just template) (Just extraHandler) = ok (strToResponse "TODO extraHandler") - handler' (Just template) Nothing = ok (toResponse (render template HashMap.empty)) + handler' (Just template) Nothing = handler'' (renderTemplate template context) + + handler'' (Left err) = internalServerError (toResponse err) + handler'' (Right renderedTemplate) = ok (toResponse renderedTemplate) strToResponse :: String -> Response strToResponse str = toResponse str diff --git a/src/Templates.hs b/src/Templates.hs index 47c53bc3201d7a65c56d12b30902c9d19fcfe6d1..f2e4b97599e5bcea5bd0cfb1881a01c6aac1c49a 100644 --- a/src/Templates.hs +++ b/src/Templates.hs @@ -4,35 +4,37 @@ module Templates where import Common -import Data.HashMap.Strict (fromList, HashMap, elems) -import qualified Data.HashMap.Strict as HashMap -import Data.Hashable -import Data.Text (Text) -import System.Exit (exitFailure) -import System.IO (IOMode(ReadMode), openFile, hGetContents) -import System.IO.Error (tryIOError) -import Text.Ginger (SourcePos +import Text.Ginger ( + easyRender + ,SourcePos ,SourceName ,ParserError(..) ,Statement(NullS) ,parseGingerFile - ,runGinger - ,toGVal - ,makeContextHtml ,formatParserError - ,VarName + ,Run + ,rawJSONToGVal ) - --(Source, IncludeResolver, peErrorMessage, peSourcePosition, SourceName, SourcePos, ParserError, makeContextHtml, Template, toGVal, runGinger, parseGingerFile, VarName) import Text.Ginger.GVal (ToGVal, GVal) -import qualified Text.Ginger.AST (Template (..)) import Text.Ginger.Html +import qualified Text.Ginger.AST (Template (..)) + import Text.Parsec.Pos (initialPos) +import qualified Data.HashMap.Strict as HashMap +import Data.HashMap.Strict (fromList, HashMap, elems) +import Data.Text (Text) +import Data.Aeson (toJSON, ToJSON) + +import Control.Monad.Writer + type Template = Text.Ginger.AST.Template SourcePos type TemplateName = SourceName type Templates = HashMap TemplateName Template type TemplateErrors = [(Maybe String, ParserError)] + + printParseErrors :: TemplateErrors -> IO () printParseErrors [(templateSource, err)] = putStrLn ("\ESC[31m" ++ "ERROR: " ++ (formatParserError templateSource err) ++ "\ESC[0m") printParseErrors (err:errs) = do @@ -41,6 +43,8 @@ printParseErrors (err:errs) = do printParseErrors _ = putStrLn "No errors." + + parseTemplates :: HashMap FilePath String -> Either TemplateErrors Templates parseTemplates templatesDir = if (null errors) then (Right templates) @@ -73,46 +77,17 @@ lookupTemplate templateName templates = HashMap.lookup (filename templateName) t --- Given a Template and a HashMap of context, render the template to Html -render :: Template -> HashMap VarName Text -> Html -render template contextMap = runGinger context template - where - contextLookup = flip scopeLookup contextMap - context = makeContextHtml contextLookup - --in htmlSource $ runGinger context template - - --- Wrapper around HashMap.lookup that applies toGVal to the value found. --- Any value referenced in a template, returned from within a template, or used --- in a template context, will be a GVal -scopeLookup - :: (Hashable k, Eq k, ToGVal m b) - => k -> HashMap.HashMap k b -> GVal m -scopeLookup key context = toGVal $ HashMap.lookup key context - - -loadFileMay :: FilePath -> IO (Maybe String) -loadFileMay fn = - tryIOError (loadFile fn) >>= \e -> - case e of - Right contents -> return (Just contents) - Left _ -> return Nothing +-- https://github.com/tdammers/ginger/issues/65 +renderTemplateText :: ToJSON c => Template -> c -> Either Text Text +renderTemplateText template ctx = do + let ctxGVal :: GVal (Run SourcePos (Writer Text) Text) = rawJSONToGVal $ toJSON ctx + let r :: Text = easyRender ctxGVal template + return r +renderTemplate :: ToJSON c => Template -> c -> Either Text Html +renderTemplate template ctx = convertRightToHtml (renderTemplateText template ctx) where - loadFile :: FilePath -> IO String - loadFile fn' = openFile fn' ReadMode >>= hGetContents - - ----- Assuming there's an html file called "base.html" in the current directory and ----- that html file's contents are `Hi, {{ name }}`, attempt to parse "base.html" ----- and print the rendered template ----- >>> run ----- "Hi, Alice" ---main :: IO () ---main = do --- template <- parseGingerFile loadFileMay "base.html" --- case template of --- Left err -> print err >> exitFailure --- Right template' -> print $ render template' sampleContext + convertRightToHtml (Left err) = Left err + convertRightToHtml (Right rendered) = Right (unsafeRawHtml rendered)