diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,5 @@ +# Revision history for type-of-html-static + +## Master + +* first draft diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2018, Florian Knupfer + +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 Florian Knupfer nor the names of other + 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/Readme.md b/Readme.md new file mode 100644 --- /dev/null +++ b/Readme.md @@ -0,0 +1,14 @@ +# Type of html static + +This little companion library of `Type of html` provides just two +little function: `static :: Document a => a -> Q Exp`. Using this +template haskell function on any part of your html document will +escape, render and lift to a Symbol at compile time. + +It increases performance a lot by avoiding any runtime computation. +By producing Proxy Symbol, it will fuse at compiletime with adjacent +elements in your document. + +`optimize :: Q Exp -> Q Exp` takes an quoted definition of a html +document and tries to convert all literals to compile time escaped +Proxy Symbol. It is less powerfull than `static` but more convenient. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/src/Html/Static.hs b/src/Html/Static.hs new file mode 100644 --- /dev/null +++ b/src/Html/Static.hs @@ -0,0 +1,63 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE FlexibleContexts #-} + +module Html.Static + ( static + , optimize + ) where + +import Language.Haskell.TH +import Data.Proxy +import Html + +-- | Template haskell function to annote which parts of a html document are static. +-- +-- >>> :t $(static (div_ "<>")) +-- Proxy "
<>
" +-- +-- Note that you can annote any part of the document which is itself a +-- valid document and doesn't contain variables which are defined in +-- the same file. +-- +-- >>> :t \x -> div_ ($(static (div_ "<>")) # x) +-- \x -> 'Div > (Proxy "
<>
" # x) +static :: Document a => a -> Q Exp +static x = pure (SigE (ConE 'Proxy) (AppT (ConT ''Proxy) (LitT (StrTyLit (renderString x))))) + +-- | Try to optimize a quoted html document at compiletime. +-- +-- >>> :t \x -> $(optimize [| div_ "a" # x |]) +-- \x -> Proxy "
a
" # x +-- +-- This function recurses into an Q Exp and turns every literal +-- expression which is applied to an element or to an attribute into a +-- Proxy Symbol. It stops recursing a branch if any other expression +-- than an element, attribute or (#) is found to avoid non +-- typechecking code, like an if statement where only one branch is +-- converted into a Proxy Symbol or an function, which wants a 'Div > +-- String as argument, receiving a Proxy Symbol. +-- +-- If you don't mind changing type signatures, this function is safe +-- to apply to any document and generally increases performance +-- substantially. +-- +-- Note that it's different to `static`: it doesn't evaluate any +-- function but it can be applied to documents with variables. It is +-- less powerfull but more convenient because you can simply apply it +-- to your entire html document. `static` you'd have to apply only to +-- parts which can be calculated statically. Be aware, that it stops +-- as well on known variables, so you have to apply it to the +-- definition of your page and not to the variable to which your +-- definition is bound. +optimize :: Q Exp -> Q Exp +optimize = fmap f + + where + f (AppE (VarE a) b) | nameModule a == Just "Html.Element" = AppE (VarE a) (f b) + f (AppE (AppE (VarE a) b) c) | nameModule a == Just "Html.Element" || nameModule a == Just "Html.Type.Internal" && nameBase a == "#" = AppE (AppE (VarE a) (f b)) (f c) + f (InfixE (Just a) (VarE b) (Just c)) | nameModule b == Just "Html.Type.Internal" && nameBase b == "#" + = InfixE (Just (f a)) (VarE b) (Just (f c)) + f (LitE (CharL x)) = SigE (ConE 'Proxy) (AppT (ConT ''Proxy) (LitT (StrTyLit (renderString x)))) + f (LitE (StringL x)) = SigE (ConE 'Proxy) (AppT (ConT ''Proxy) (LitT (StrTyLit (renderString x)))) + f (LitE (IntegerL x)) = SigE (ConE 'Proxy) (AppT (ConT ''Proxy) (LitT (StrTyLit (renderString x)))) + f x = x diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 --- /dev/null +++ b/test/Main.hs @@ -0,0 +1,37 @@ +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE DataKinds #-} + +module Main where + +import Html +import Html.Static + +import Data.Proxy + +main :: IO () +main = pure () + where + _t_ = + ( div_ "a" :: 'Div > String + , $(static (div_ "a")) :: Proxy "
a
" + , $(static (map td_ [1..3::Int])) :: Proxy "123" + , $(static (div_ "<")) :: Proxy "
<
" + ) + +helloWorld + :: ('Title ?> a) + => a + -> 'Html > (('Head > ('Title > a)) # ('Body > ('P > Proxy "Hello World!"))) +helloWorld x = $(optimize [| + html_ + ( head_ + ( title_ x + ) + # body_ + ( p_ "Hello World!" + ) + ) + |]) diff --git a/type-of-html-static.cabal b/type-of-html-static.cabal new file mode 100644 --- /dev/null +++ b/type-of-html-static.cabal @@ -0,0 +1,40 @@ +name: type-of-html-static +version: 0.1.0.1 +synopsis: Optimize static parts of type-of-html. +description: This library provides the TH-function 'static' to annote which parts of your page are static to dramatically increase performance. + It converts and escapes it's argument at compiletime and lifts it to a Proxy Symbol to avoid even appending of Builder. +license: BSD3 +license-file: LICENSE +author: Florian Knupfer +maintainer: fknupfer@gmail.com +homepage: https://github.com/knupfer/type-of-html-static +tested-with: GHC == 8.2.2 + , GHC == 8.4.2 +copyright: 2018, Florian Knupfer +category: Language, Text, Web, HTML +build-type: Simple +extra-source-files: ChangeLog.md + , Readme.md +cabal-version: >=1.10 +source-repository head + Type: git + Location: https://github.com/knupfer/type-of-html-static + +library + exposed-modules: Html.Static + hs-source-dirs: src + default-language: Haskell2010 + ghc-options: -Wall + build-depends: base >=4.9 && < 5 + , type-of-html + , template-haskell + +test-suite test + type: exitcode-stdio-1.0 + main-is: Main.hs + hs-source-dirs: test + ghc-options: -Wall + default-language: Haskell2010 + build-depends: base >= 4.9 && < 5 + , type-of-html + , type-of-html-static