Working html generation example
This commit is contained in:
parent
8098ed3c53
commit
dc3c49cdf6
5 changed files with 97 additions and 12 deletions
48
examples/examples.ipkg
Normal file
48
examples/examples.ipkg
Normal file
|
@ -0,0 +1,48 @@
|
||||||
|
package ssg-examples
|
||||||
|
version = 0.1.0
|
||||||
|
authors = "Nathan McCarty"
|
||||||
|
-- maintainers =
|
||||||
|
-- license =
|
||||||
|
-- brief =
|
||||||
|
-- readme =
|
||||||
|
-- homepage =
|
||||||
|
-- sourceloc =
|
||||||
|
-- bugtracker =
|
||||||
|
|
||||||
|
-- the Idris2 version required (e.g. langversion >= 0.5.1)
|
||||||
|
-- langversion
|
||||||
|
|
||||||
|
-- packages to add to search path
|
||||||
|
depends = SSG
|
||||||
|
, structures
|
||||||
|
|
||||||
|
-- modules to install
|
||||||
|
modules = HelloWorld
|
||||||
|
|
||||||
|
-- main file (i.e. file to load at REPL)
|
||||||
|
-- main = Main
|
||||||
|
|
||||||
|
-- name of executable
|
||||||
|
-- executable = "SSG-test"
|
||||||
|
-- opts =
|
||||||
|
sourcedir = "src"
|
||||||
|
-- builddir =
|
||||||
|
-- outputdir =
|
||||||
|
|
||||||
|
-- script to run before building
|
||||||
|
-- prebuild =
|
||||||
|
|
||||||
|
-- script to run after building
|
||||||
|
-- postbuild =
|
||||||
|
|
||||||
|
-- script to run after building, before installing
|
||||||
|
-- preinstall =
|
||||||
|
|
||||||
|
-- script to run after installing
|
||||||
|
-- postinstall =
|
||||||
|
|
||||||
|
-- script to run before cleaning
|
||||||
|
-- preclean =
|
||||||
|
|
||||||
|
-- script to run after cleaning
|
||||||
|
-- postclean =
|
19
examples/src/HelloWorld.idr
Normal file
19
examples/src/HelloWorld.idr
Normal file
|
@ -0,0 +1,19 @@
|
||||||
|
module HelloWorld
|
||||||
|
|
||||||
|
import SSG.HTML
|
||||||
|
|
||||||
|
import Structures.Dependent.DList
|
||||||
|
|
||||||
|
helloWorld : Html "html"
|
||||||
|
helloWorld =
|
||||||
|
Normal "html" ["lang" =$ "en"] [
|
||||||
|
Normal "head" [] [
|
||||||
|
RawText "title" [] "Example"
|
||||||
|
],
|
||||||
|
Normal "body" [] [
|
||||||
|
Normal "p" [] [Text "Hello World!"]
|
||||||
|
]
|
||||||
|
]
|
||||||
|
|
||||||
|
main : IO ()
|
||||||
|
main = putStr $ render helloWorld
|
|
@ -8,3 +8,8 @@ test = "test/test.ipkg"
|
||||||
type = "local"
|
type = "local"
|
||||||
path = "test"
|
path = "test"
|
||||||
ipkg = "test.ipkg"
|
ipkg = "test.ipkg"
|
||||||
|
|
||||||
|
[custom.all.ssg-examples]
|
||||||
|
type = "local"
|
||||||
|
path = "examples"
|
||||||
|
ipkg = "examples.ipkg"
|
||||||
|
|
|
@ -5,7 +5,7 @@ import public SSG.HTML.ElementTypes
|
||||||
import Data.String
|
import Data.String
|
||||||
import Decidable.Equality
|
import Decidable.Equality
|
||||||
|
|
||||||
import Structures.Dependent.DList
|
import public Structures.Dependent.DList
|
||||||
|
|
||||||
export infix 8 =$
|
export infix 8 =$
|
||||||
|
|
||||||
|
@ -22,10 +22,10 @@ namespace Attribute
|
||||||
toString (attribute =$ value) =
|
toString (attribute =$ value) =
|
||||||
let value_cs = unpack value
|
let value_cs = unpack value
|
||||||
in if any (== '\'') value_cs
|
in if any (== '\'') value_cs
|
||||||
then "\"\{value}\""
|
then "\{attribute}=\"\{value}\""
|
||||||
else if any (== '"') value_cs || any (== ' ') value_cs
|
else if any (== '"') value_cs || any (== ' ') value_cs
|
||||||
then "'\{value}'"
|
then "\{attribute}='\{value}'"
|
||||||
else value
|
else "\{attribute}=\{value}"
|
||||||
|
|
||||||
||| An element in an HTML document, indexed by the tag type.
|
||| An element in an HTML document, indexed by the tag type.
|
||||||
|||
|
|||
|
||||||
|
@ -54,6 +54,7 @@ data Html : String -> Type where
|
||||||
namespace Html
|
namespace Html
|
||||||
||| Convert to a "pretty printed" string containing the html, starting at the
|
||| Convert to a "pretty printed" string containing the html, starting at the
|
||||||
||| specified indentation level
|
||| specified indentation level
|
||||||
|
export
|
||||||
viewIndented : (indent_level : Nat) -> Html type -> String
|
viewIndented : (indent_level : Nat) -> Html type -> String
|
||||||
viewIndented indent_level (Text content) =
|
viewIndented indent_level (Text content) =
|
||||||
replicate (indent_level * 2) ' ' ++ content
|
replicate (indent_level * 2) ' ' ++ content
|
||||||
|
@ -68,27 +69,38 @@ namespace Html
|
||||||
let indent = replicate (indent_level * 2) ' ' in
|
let indent = replicate (indent_level * 2) ' ' in
|
||||||
-- Special handling if the tag contains exactly one `Text` element, we won't
|
-- Special handling if the tag contains exactly one `Text` element, we won't
|
||||||
-- do any newlines between the tag and its contents in that case
|
-- do any newlines between the tag and its contents in that case
|
||||||
case decEq content_types [""] of
|
case decEq [""] content_types of
|
||||||
Yes prf => ?viewIndented_rhs_4
|
Yes prf => assert_total $ -- BUG Compiler Bug ???
|
||||||
|
let [Text content] : DList _ Html [""] = rewrite prf in contents
|
||||||
|
in if length attributes > 0
|
||||||
|
then
|
||||||
|
let attrs = joinBy " " $ map toString attributes
|
||||||
|
in "\{indent}<\{type} \{attrs}>\{content}</\{type}>"
|
||||||
|
else "\{indent}<\{type}>\{content}</\{type}>"
|
||||||
No contra =>
|
No contra =>
|
||||||
let start = "\{indent}<\{type}>\n"
|
let end = "\n\{indent}</\{type}>"
|
||||||
end = "\{indent}</\{type}>\n"
|
|
||||||
inner = joinBy "\n" $
|
inner = joinBy "\n" $
|
||||||
dMap (\_, x => viewIndented (S indent_level) x) contents
|
dMap (\_, x => viewIndented (S indent_level) x) contents
|
||||||
in start ++ end ++ inner
|
in if length attributes > 0
|
||||||
|
then
|
||||||
|
let attrs = joinBy " " $ map toString attributes
|
||||||
|
in "\{indent}<\{type} \{attrs}>\n" ++ inner ++ end
|
||||||
|
else "\{indent}<\{type}>\n" ++ inner ++ end
|
||||||
viewIndented indent_level (RawText type attributes content) =
|
viewIndented indent_level (RawText type attributes content) =
|
||||||
let indent = replicate (indent_level * 2) ' ' in
|
let indent = replicate (indent_level * 2) ' ' in
|
||||||
if length attributes > 0
|
if length attributes > 0
|
||||||
then
|
then
|
||||||
let attrs = joinBy " " $ map toString attributes
|
let attrs = joinBy " " $ map toString attributes
|
||||||
in "<\{type} \{attrs}>\{content}</\{type}>"
|
in "\{indent}<\{type} \{attrs}>\{content}</\{type}>"
|
||||||
else "<\{type}>\{content}</\{type}>"
|
else "\{indent}<\{type}>\{content}</\{type}>"
|
||||||
|
|
||||||
||| Convert to a "pretty printed" string containing the html
|
||| Convert to a "pretty printed" string containing the html
|
||||||
|
export
|
||||||
view : Html type -> String
|
view : Html type -> String
|
||||||
view = viewIndented 0
|
view = viewIndented 0
|
||||||
|
|
||||||
||| Render a top level html document, including the doctype tag
|
||| Render a top level html document, including the doctype tag
|
||||||
|
export
|
||||||
render : Html "html" -> String
|
render : Html "html" -> String
|
||||||
render x =
|
render x =
|
||||||
"<!DOCTYPE HTML>\n" ++ viewIndented 0 x
|
"<!DOCTYPE HTML>\n" ++ viewIndented 0 x
|
||||||
|
|
|
@ -36,6 +36,7 @@ data IsNormal : String -> Type where
|
||||||
-- Document element
|
-- Document element
|
||||||
IsHtml : IsNormal "html"
|
IsHtml : IsNormal "html"
|
||||||
-- Sections
|
-- Sections
|
||||||
|
IsHead : IsNormal "head"
|
||||||
IsBody : IsNormal "body"
|
IsBody : IsNormal "body"
|
||||||
IsArticle : IsNormal "article"
|
IsArticle : IsNormal "article"
|
||||||
IsSection : IsNormal "section"
|
IsSection : IsNormal "section"
|
||||||
|
|
Loading…
Add table
Reference in a new issue