htmlを吐き出す3 - Rodhos Soft

不要なデータ型を削除した少しスッキリしたが属性とかつけるとめんどくさいことになりそう。

import Data.List
main = putStr (tag_doctype ++ html)

tag_doctype = "<!DOCTYPE html>"

html = string (HTML [header,body])
header = HEAD [String "OK!"]
body =  BODY htmlbody

htmlbody = [DIV [P [String "Hello"]]]

class TransString a where
  string::a -> String
  stringjoin::[a] -> String
  stringjoin list = intercalate "" (map string list)

data Anchor = A { aURL::String, aLabel::String}
instance TransString Anchor where
  string (A { aURL=u, aLabel=l}) = (tagatt "a" (attr "href" (qua u)) l)

-- 色々なタグをタグでまとめた。
data TAG =HTML [TAG]
          |HEAD [TAG]
          |BODY [TAG]
          |TITLE [TAG]
          |DIV [TAG]
          |P [TAG]
          |String String

instance TransString TAG where
  string (HTML tags) = tag "html" (stringjoin tags)
  string (HEAD tags) = tag "head" (stringjoin tags)
  string (BODY tags) = tag "body" (stringjoin tags)
  string (TITLE tags) = tag "title" (stringjoin tags)
  string (DIV tags) = tag "div" (stringjoin tags)
  string (P tags) = tag "p" (stringjoin tags)
  string (String txt) = txt


tag::String -> String -> String
tag name txt = "<"++name++">" ++ txt ++ "</"++name++">"

attr::String -> String -> String
attr name txt = name ++ "=" ++ txt

tagatt::String -> String -> String->String
tagatt name att txt = "<" ++ name ++ " " ++ att ++ ">" ++ txt ++ "</"++name++">"

qua::String->String
qua txt = "'" ++ txt ++ "'"

trycode::(TransString a) => a -> String
trycode x = string x

divにクラスを入れるようにしてみたがこれ以上やると複雑化しそうなので別の道を考える。。

import Data.List
main = putStr (tag_doctype ++ html)

tag_doctype = "<!DOCTYPE html>"

html = string (HTML [header,body])
header = HEAD [String "OK!"]
body =  BODY htmlbody

htmlbody = [DIV "di" [P [String "Hello"]]]


class TransString a where
  string::a -> String
  stringjoin::[a] -> String
  stringjoin list = intercalate "" (map string list)

data Anchor = A { aURL::String, aLabel::String}
instance TransString Anchor where
  string (A { aURL=u, aLabel=l}) = (tagatt "a" (attr "href" (qua u)) l)

-- 色々なタグをタグでまとめた。
type ClassName = String
data TAG =HTML [TAG]
          |HEAD [TAG]
          |BODY [TAG]
          |TITLE [TAG]
          |DIV ClassName [TAG]
          |P [TAG]
          |String String

instance TransString TAG where
  string (HTML tags) = tag "html" (stringjoin tags)
  string (HEAD tags) = tag "head" (stringjoin tags)
  string (BODY tags) = tag "body" (stringjoin tags)
  string (TITLE tags) = tag "title" (stringjoin tags)
  string (DIV cname tags) = tagatt "div" (attr "class" (qua cname)) (stringjoin tags)
  string (P tags) = tag "p" (stringjoin tags)
  string (String txt) = txt


type TagName = String
tag::TagName -> String -> String
tag name txt = "<"++name++">" ++ txt ++ "</"++name++">"

type AttributeName = String
type AttributeString = String
attr::AttributeName -> String -> AttributeString
attr name txt = name ++ "=" ++ txt


tagatt::TagName -> AttributeString -> String -> String
tagatt name att txt = "<" ++ name ++ " " ++ att ++ ">" ++ txt ++ "</"++name++">"

qua::String->String
qua txt = "'" ++ txt ++ "'"

trycode::(TransString a) => a -> String
trycode x = string x