Shpadoinkle-template (empty) → 0.0.0.1
raw patch · 8 files changed
+236/−0 lines, 8 filesdep +Shpadoinkledep +Shpadoinkle-backend-staticdep +Shpadoinkle-templatesetup-changed
Dependencies added: Shpadoinkle, Shpadoinkle-backend-static, Shpadoinkle-template, base, file-embed, html-parse, template-haskell, text
Files
- CHANGELOG.md +0/−0
- LICENSE +27/−0
- README.md +37/−0
- Setup.hs +2/−0
- Shpadoinkle-template.cabal +62/−0
- Shpadoinkle/Template.hs +17/−0
- Shpadoinkle/Template/TH.hs +53/−0
- Test.hs +38/−0
+ CHANGELOG.md view
+ LICENSE view
@@ -0,0 +1,27 @@+Shpadoinkle Template aka S11 Core+Copyright © 2021 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.
+ README.md view
@@ -0,0 +1,37 @@+# Shpadoinkle Template++[](https://gitlab.com/fresheyeball/Shpadoinkle)+[](https://shpadoinkle.org/template)+[](https://opensource.org/licenses/BSD-3-Clause)+[](https://builtwithnix.org)+[](https://hackage.haskell.org/package/Shpadoinkle-template)+[](http://packdeps.haskellers.com/reverse/Shpadoinkle-template)+[](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+<h1>Hi!</h1>+<div>Nice to meat you</div>+```++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+<div class="my-view">+ <h1>Hi!</h1>+ <div>Nice to meat you</div>+</div>+```
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ Shpadoinkle-template.cabal view
@@ -0,0 +1,62 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.33.0.+--+-- see: https://github.com/sol/hpack+--+-- hash: b12f6991d22c408f646249268554550793acbdcedcc5d8b448606f1de6cda389++name: Shpadoinkle-template+version: 0.0.0.1+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.+category: Web+author: Isaac Shapira+maintainer: fresheyeball@protonmail.com+license: BSD3+license-file: LICENSE+build-type: Simple+extra-source-files:+ README.md+ CHANGELOG.md++source-repository head+ type: git+ location: https://gitlab.com/fresheyeball/Shpadoinkle.git++library+ exposed-modules:+ Shpadoinkle.Template.TH+ Shpadoinkle.Template+ hs-source-dirs:+ ./.+ ghc-options: -Wall -Wcompat -fwarn-redundant-constraints -fwarn-incomplete-uni-patterns -fwarn-tabs -fwarn-incomplete-record-updates -fwarn-identities+ build-depends:+ Shpadoinkle+ , Shpadoinkle-backend-static+ , base >=4.12.0 && <4.16+ , html-parse+ , template-haskell+ , text >=1.2.3 && <1.3+ default-language: Haskell2010++test-suite sample+ type: exitcode-stdio-1.0+ main-is: Test.hs+ other-modules:+ Shpadoinkle.Template+ Shpadoinkle.Template.TH+ Paths_Shpadoinkle_template+ hs-source-dirs:+ ./.+ ghc-options: -Wall -Wcompat -fwarn-redundant-constraints -fwarn-incomplete-uni-patterns -fwarn-tabs -fwarn-incomplete-record-updates -fwarn-identities+ build-depends:+ Shpadoinkle+ , Shpadoinkle-backend-static+ , Shpadoinkle-template+ , base >=4.12.0 && <4.16+ , file-embed+ , html-parse+ , template-haskell+ , text >=1.2.3 && <1.3+ default-language: Haskell2010
+ Shpadoinkle/Template.hs view
@@ -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'++
+ Shpadoinkle/Template/TH.hs view
@@ -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 (UnboundVarE $ mkName "pack") . LitE . StringL . unpack
+ Test.hs view
@@ -0,0 +1,38 @@+{-# 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+import Shpadoinkle.Template.TH+++testHtmlIngestion :: IO ()+testHtmlIngestion =+ let x = mconcat $ renderStatic <$> $(embedHtml "./test.html")+ y = decodeUtf8 $(embedFile "./test.html")+ 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 = "<divyoddle yoddleclass=\"baryoddle\"><span>Hi yoddle</span></divyoddle>"+ in if x == y then pure () else+ error $ "template did not interpolate. Got: " ++ unpack x++main :: IO ()+main = do+ testHtmlIngestion+ testTemplate+ putStrLn "SUCCESS"