From c671b27386fd178f6a989282f51618df0f290e94 Mon Sep 17 00:00:00 2001 From: Isaac Shapira Date: Thu, 11 Mar 2021 23:03:52 -0700 Subject: [PATCH 1/4] add template package --- cabal.project | 1 + hie.yaml | 6 ++++ nix/base.nix | 1 + nix/hpackall.sh | 1 + nix/overlay-shpadoinkle.nix | 1 + template/CHANGELOG.md | 0 template/LICENSE | 27 ++++++++++++++ template/README.md | 0 template/Setup.hs | 2 ++ template/Shpadoinkle/Template/TH.hs | 53 +++++++++++++++++++++++++++ template/Test.hs | 22 ++++++++++++ template/default.nix | 4 +++ template/package.yaml | 56 +++++++++++++++++++++++++++++ template/test.html | 5 +++ 14 files changed, 179 insertions(+) create mode 100644 template/CHANGELOG.md create mode 100644 template/LICENSE create mode 100644 template/README.md create mode 100644 template/Setup.hs create mode 100644 template/Shpadoinkle/Template/TH.hs create mode 100644 template/Test.hs create mode 100644 template/default.nix create mode 100644 template/package.yaml create mode 100644 template/test.html diff --git a/cabal.project b/cabal.project index a6a761b7..c9e9d5b2 100644 --- a/cabal.project +++ b/cabal.project @@ -12,6 +12,7 @@ packages: core , router , streaming , widgets + , template , examples diff --git a/hie.yaml b/hie.yaml index 95df5d38..4ab633ab 100644 --- a/hie.yaml +++ b/hie.yaml @@ -91,6 +91,12 @@ cradle: cabal: component: "widgets" + - path: "./template/" + config: + cradle: + cabal: + component: "template" + - path: "./examples/TODOMVC.hs" config: cradle: diff --git a/nix/base.nix b/nix/base.nix index 3bfb221c..1eef676d 100644 --- a/nix/base.nix +++ b/nix/base.nix @@ -52,6 +52,7 @@ in Shpadoinkle-streaming Shpadoinkle-widgets Shpadoinkle-isreal + Shpadoinkle-template Shpadoinkle-tests; Shpadoinkle-examples = cannibal haskell.packages.${util.compilerjs}.Shpadoinkle-examples; diff --git a/nix/hpackall.sh b/nix/hpackall.sh index 906451f1..17eac857 100755 --- a/nix/hpackall.sh +++ b/nix/hpackall.sh @@ -15,5 +15,6 @@ p marketing p widgets p examples p tests +p template p isreal p streaming diff --git a/nix/overlay-shpadoinkle.nix b/nix/overlay-shpadoinkle.nix index 06f0ef9d..6a20b86b 100644 --- a/nix/overlay-shpadoinkle.nix +++ b/nix/overlay-shpadoinkle.nix @@ -162,6 +162,7 @@ in { Shpadoinkle-router = call "Shpadoinkle-router" ../router; Shpadoinkle-streaming = call "Shpadoinkle-streaming" ../streaming; Shpadoinkle-widgets = addTest (call "Shpadoinkle-widgets" ../widgets) hpkgs; + Shpadoinkle-template = call "Shpadoinkle-template" ../template; Shpadoinkle-tests = super.haskell.packages.${compiler}.callCabal2nix "tests" (gitignore ../tests) {}; Shpadoinkle-examples = call "Shpadoinkle-examples" ../examples; diff --git a/template/CHANGELOG.md b/template/CHANGELOG.md new file mode 100644 index 00000000..e69de29b diff --git a/template/LICENSE b/template/LICENSE new file mode 100644 index 00000000..611223f1 --- /dev/null +++ b/template/LICENSE @@ -0,0 +1,27 @@ +Shpadoinkle Core aka S11 Core +Copyright © 2020 Isaac Shapira +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Shpadoinkle nor the names of its contributors may be + used to endorse or promote products derived from this software without + specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +POSSIBILITY OF SUCH DAMAGE. diff --git a/template/README.md b/template/README.md new file mode 100644 index 00000000..e69de29b diff --git a/template/Setup.hs b/template/Setup.hs new file mode 100644 index 00000000..44671092 --- /dev/null +++ b/template/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/template/Shpadoinkle/Template/TH.hs b/template/Shpadoinkle/Template/TH.hs new file mode 100644 index 00000000..7188d7f7 --- /dev/null +++ b/template/Shpadoinkle/Template/TH.hs @@ -0,0 +1,53 @@ +{-# LANGUAGE LambdaCase #-} + + +module Shpadoinkle.Template.TH where + + +import Data.Text (Text, cons, unpack) +import Data.Text.IO +import Language.Haskell.TH.Syntax +import Prelude hiding (readFile) +import Text.HTML.Parser (Attr (..), Token (..), parseTokens) + + +embedHtml :: FilePath -> Q Exp +embedHtml path = do + ts <- runIO $ parseTokens <$> readFile path + pure . ListE $ tokenToExp ts + + +tokenToExp :: [Token] -> [Exp] +tokenToExp = + let h = UnboundVarE $ mkName "h" + text = UnboundVarE $ mkName "text" in \case + TagOpen tn attrs:ts -> + let attrs' = ListE $ attrToExp <$> attrs + name = asText tn + (children, siblings) = break (\case TagClose tn' | tn' == tn -> True; _ -> False) ts + in AppE (AppE (AppE h name) attrs') (ListE $ tokenToExp children) : tokenToExp (drop 1 siblings) + TagSelfClose tn attrs:ts -> + let attrs' = ListE $ attrToExp <$> attrs + name = asText tn + in AppE (AppE (AppE h name) attrs') (ListE []) : tokenToExp ts + TagClose _:ts -> tokenToExp ts + ContentText content:ts -> + let content' = asText content + in AppE text content' : tokenToExp ts + ContentChar char:ts -> + let char' = asText $ cons char mempty + in AppE text char' : tokenToExp ts + Comment _:ts -> tokenToExp ts + Doctype _:ts -> tokenToExp ts + [] -> [] + + +attrToExp :: Attr -> Exp +attrToExp (Attr name value) = TupE [name', AppE textProp value'] + where textProp = UnboundVarE $ mkName "textProp" + name' = asText name + value' = asText value + +asText :: Text -> Exp +asText = AppE pack . LitE . StringL . unpack + where pack = UnboundVarE $ mkName "pack" diff --git a/template/Test.hs b/template/Test.hs new file mode 100644 index 00000000..289ed8b5 --- /dev/null +++ b/template/Test.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} + + +module Main where + + +import Data.FileEmbed +import Data.Text +import Data.Text.Encoding +import Shpadoinkle +import Shpadoinkle.Backend.Static +import Shpadoinkle.Template.TH + + +main :: IO () +main = + let x = mconcat $ renderStatic <$> $(embedHtml "./test.html") + y = decodeUtf8 $(embedFile "./test.html") + in if x == y + then putStrLn "SUCCESS" + else error $ "test.html did not parse correctly. Got: " ++ unpack x diff --git a/template/default.nix b/template/default.nix new file mode 100644 index 00000000..7578d7bb --- /dev/null +++ b/template/default.nix @@ -0,0 +1,4 @@ +import ../default.nix { pack = "Shpadoinkle"; } + + + diff --git a/template/package.yaml b/template/package.yaml new file mode 100644 index 00000000..ec583c81 --- /dev/null +++ b/template/package.yaml @@ -0,0 +1,56 @@ +name: Shpadoinkle-template +license: BSD3 +license-file: LICENSE +version: 0.0.0.1 +author: Isaac Shapira +maintainer: fresheyeball@protonmail.com +category: Web +build-type: Simple +synopsis: Read standard file formats into Shpadoinkle with Template Haskell +description: + This package provides TH functions to read files at compile time and embed them + into Shpadoinkle views. + + +ghc-options: + - -Wall + - -Wcompat + - -fwarn-redundant-constraints + - -fwarn-incomplete-uni-patterns + - -fwarn-tabs + - -fwarn-incomplete-record-updates + - -fwarn-identities + + +extra-source-files: + - README.md + - CHANGELOG.md + + +dependencies: + - base >= 4.12.0 && < 4.16 + - text >= 1.2.3 && < 1.3 + - template-haskell + - html-parse + + - Shpadoinkle + - Shpadoinkle-backend-static + + +library: + exposed-modules: + - Shpadoinkle.Template.TH + other-modules: [] + source-dirs: . + + +tests: + sample: + main: Test.hs + source-dirs: . + dependencies: + - Shpadoinkle-template + - file-embed + + +git: https://gitlab.com/fresheyeball/Shpadoinkle.git diff --git a/template/test.html b/template/test.html new file mode 100644 index 00000000..1dc03d96 --- /dev/null +++ b/template/test.html @@ -0,0 +1,5 @@ +
+ + Shocka zooloo +
+

Wak!

-- GitLab From 17956242781e13cb5bc3b3a1ee1cd3dca8136ead Mon Sep 17 00:00:00 2001 From: Isaac Shapira Date: Thu, 11 Mar 2021 23:12:14 -0700 Subject: [PATCH 2/4] readme --- template/LICENSE | 4 ++-- template/README.md | 37 +++++++++++++++++++++++++++++++++++++ 2 files changed, 39 insertions(+), 2 deletions(-) diff --git a/template/LICENSE b/template/LICENSE index 611223f1..8db13126 100644 --- a/template/LICENSE +++ b/template/LICENSE @@ -1,5 +1,5 @@ -Shpadoinkle Core aka S11 Core -Copyright © 2020 Isaac Shapira +Shpadoinkle Template aka S11 Core +Copyright © 2021 Isaac Shapira All rights reserved. Redistribution and use in source and binary forms, with or without diff --git a/template/README.md b/template/README.md index e69de29b..4d79325e 100644 --- a/template/README.md +++ b/template/README.md @@ -0,0 +1,37 @@ +# Shpadoinkle Template + +[![Goldwater](https://gitlab.com/fresheyeball/Shpadoinkle/badges/master/pipeline.svg)](https://gitlab.com/fresheyeball/Shpadoinkle) +[![Haddock](https://img.shields.io/badge/haddock-master-informational)](https://shpadoinkle.org/template) +[![BSD-3](https://img.shields.io/badge/License-BSD%203--Clause-blue.svg)](https://opensource.org/licenses/BSD-3-Clause) +[![built with nix](https://img.shields.io/badge/built%20with-nix-41439a)](https://builtwithnix.org) +[![Hackage](https://img.shields.io/hackage/v/Shpadoinkle-template.svg)](https://hackage.haskell.org/package/Shpadoinkle-template) +[![Hackage Deps](https://img.shields.io/hackage-deps/v/Shpadoinkle-template.svg)](http://packdeps.haskellers.com/reverse/Shpadoinkle-template) +[![Hackage CI](https://matrix.hackage.haskell.org/api/v2/packages/Shpadoinkle-template/badge)](https://matrix.hackage.haskell.org/#/package/Shpadoinkle-template) + +This module provides the ability to read files into Shpadoinkle views. + +## Usage + +Lets say you have `template.html` + +```html +

Hi!

+
Nice to meat you
+``` + +you can now embed it into a Shpadoinkle + +```haskell +view :: Html m a +view = div [ className "my-view" ] $(embedHtml "./template.html") +``` + + +which will render as + +```html +
+

Hi!

+
Nice to meat you
+
+``` -- GitLab From f8c25876375bbd4d590d5eda77f09a7c1e1e39c1 Mon Sep 17 00:00:00 2001 From: Isaac Shapira Date: Thu, 11 Mar 2021 23:13:29 -0700 Subject: [PATCH 3/4] clean up --- template/default.nix | 2 +- template/package.yaml | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/template/default.nix b/template/default.nix index 7578d7bb..c5e71761 100644 --- a/template/default.nix +++ b/template/default.nix @@ -1,4 +1,4 @@ -import ../default.nix { pack = "Shpadoinkle"; } +import ../default.nix { pack = "Shpadoinkle-template"; } diff --git a/template/package.yaml b/template/package.yaml index ec583c81..86e2d9df 100644 --- a/template/package.yaml +++ b/template/package.yaml @@ -29,7 +29,7 @@ extra-source-files: dependencies: - base >= 4.12.0 && < 4.16 - - text >= 1.2.3 && < 1.3 + - text >= 1.2.3 && < 1.3 - template-haskell - html-parse -- GitLab From 739b8caaf47e019f7a9bd5f2f487335789a934d8 Mon Sep 17 00:00:00 2001 From: Isaac Shapira Date: Fri, 12 Mar 2021 21:25:23 -0700 Subject: [PATCH 4/4] simple templater --- template/Shpadoinkle/Template.hs | 17 +++++++++++++++++ template/Shpadoinkle/Template/TH.hs | 4 ++-- template/Test.hs | 26 +++++++++++++++++++++----- template/package.yaml | 1 + 4 files changed, 41 insertions(+), 7 deletions(-) create mode 100644 template/Shpadoinkle/Template.hs diff --git a/template/Shpadoinkle/Template.hs b/template/Shpadoinkle/Template.hs new file mode 100644 index 00000000..10d6d1ee --- /dev/null +++ b/template/Shpadoinkle/Template.hs @@ -0,0 +1,17 @@ +module Shpadoinkle.Template where + + +import Data.Text +import Shpadoinkle + + +template :: (Text -> Text) -> Html m a -> Html m a +template r (Html html) = Html $ \n p t -> + html (\tn ps cs -> + n (r tn) + ((\(k,v) -> (r k, case v of PText pt -> PText (r pt); x -> x)) <$> ps) + cs) + p $ + \t' -> t $ r t' + + diff --git a/template/Shpadoinkle/Template/TH.hs b/template/Shpadoinkle/Template/TH.hs index 7188d7f7..a60d0a47 100644 --- a/template/Shpadoinkle/Template/TH.hs +++ b/template/Shpadoinkle/Template/TH.hs @@ -48,6 +48,6 @@ attrToExp (Attr name value) = TupE [name', AppE textProp value'] name' = asText name value' = asText value + asText :: Text -> Exp -asText = AppE pack . LitE . StringL . unpack - where pack = UnboundVarE $ mkName "pack" +asText = AppE (UnboundVarE $ mkName "pack") . LitE . StringL . unpack diff --git a/template/Test.hs b/template/Test.hs index 289ed8b5..e261e447 100644 --- a/template/Test.hs +++ b/template/Test.hs @@ -10,13 +10,29 @@ import Data.Text import Data.Text.Encoding import Shpadoinkle import Shpadoinkle.Backend.Static +import Shpadoinkle.Template import Shpadoinkle.Template.TH -main :: IO () -main = +testHtmlIngestion :: IO () +testHtmlIngestion = let x = mconcat $ renderStatic <$> $(embedHtml "./test.html") y = decodeUtf8 $(embedFile "./test.html") - in if x == y - then putStrLn "SUCCESS" - else error $ "test.html did not parse correctly. Got: " ++ unpack x + in if x == y then pure () else + error $ "test.html did not parse correctly. Got: " ++ unpack x + +testTemplate :: IO () +testTemplate = + let x = renderStatic $ template (replace "{{x}}" "yoddle") $ + h "div{{x}}" [ ("{{x}}class", textProp "bar{{x}}") ] + [ h "span" [] [ "Hi {{x}}" ] + ] + y = "Hi yoddle" + in if x == y then pure () else + error $ "template did not interpolate. Got: " ++ unpack x + +main :: IO () +main = do + testHtmlIngestion + testTemplate + putStrLn "SUCCESS" diff --git a/template/package.yaml b/template/package.yaml index 86e2d9df..1067380c 100644 --- a/template/package.yaml +++ b/template/package.yaml @@ -40,6 +40,7 @@ dependencies: library: exposed-modules: - Shpadoinkle.Template.TH + - Shpadoinkle.Template other-modules: [] source-dirs: . -- GitLab