単にテンプレート的にhtmlを吐き出す
単純に関数に代入してhtmlを作ってみたがお世辞にも簡潔には書けなかった。。
import Data.List main = putStrLn html tag_doctype = "<!DOCTYPE html>\n" tag_html txt = "\n<html>\n" ++ txt ++ "\n</html>\n" tag_head txt = "\n<head>\n" ++ txt ++ "\n</head>\n" tag_body txt = "\n<body>\n" ++ txt ++ "\n</body>\n" tag_title txt = "\n<title>\n" ++ txt ++ "\n</title>\n" tag_meta charset = "\n<meta charset=" ++ charset ++ ">\n" tag_header txt = "\n<header class='header'>\n" ++ txt ++ "\n</header>\n" tag_footer txt = "\n<footer class='footer'>\n" ++ txt ++ "\n</footer>\n" tag_div cls txt = "\n<div class='"++cls++"'>\n" ++ txt ++ "\n</div>\n" tag_main cls txt = "\n<main class='" ++cls++ "'>\n" ++ txt ++ "\n</main>\n" tag_style txt = "\n<style type='text/css'>\n" ++ txt ++ "\n</style>\n" tag_h1 cls txt = "\n<h1 class='" ++cls++ "'>\n" ++ txt ++ "\n</h1>\n" tag_h2 cls txt = "\n<h2 class='" ++cls++ "'>\n" ++ txt ++ "\n</h2>\n" tag_h3 cls txt = "\n<h3 class='" ++cls++ "'>\n" ++ txt ++ "\n</h3>\n" tag_p cls txt = "\n<p class='" ++cls++ "'>\n" ++ txt ++ "\n</p>\n" tag_time cls datetime txt = "\n<h3 class='" ++cls++ "' datetime='" ++datetime++ "'>\n" ++ txt ++ "\n</h3>\n" tag_a cls href txt = "\n<a class='" ++cls++ "' href='" ++href++ "'>\n" ++ txt ++ "\n</a>\n" tag_nav cls txt = "\n<nav class='" ++cls++ "'>\n" ++ txt ++ "\n</nav>\n" tag_ul cls txt = "\n<ul class='" ++cls++ "'>\n" ++ txt ++ "\n</ul>\n" tag_li cls txt = "\n<li class='" ++cls++ "'>\n" ++ txt ++ "\n</li>\n" tag_img cls src alt = "\n<img class='" ++cls++ "'" ++" src=" ++ src ++ " alt=" ++ alt ++ ">\n" tag_link rel href = "\n<link rel=" ++ "'"++ rel ++"'" ++ " href=" ++ href ++ ">\n" tag_span cls txt = "\n<span class='" ++cls++ "'>\n" ++ txt ++ "\n</span>\n" hiragino = "'Hiragino Kaku Gothic ProN', Meiryo, sans-serif" fontsize txt = "font-size:" ++ txt ++ ";" font_weight txt = "font-weight:" ++ txt ++ ";" font_family txt = "font-family:" ++ txt ++ ";" box_sizing txt = "box-sizing:" ++ txt ++ ";" text_decoration txt = "text-decoration:" ++ txt ++ ";" padding txt = "padding:" ++ txt ++ ";" color txt = "color:" ++ txt ++ ";" background txt = "background:" ++ txt ++ ";" background_color txt = "background-color:" ++ txt ++ ";" box_shadow txt = "box-shadow:" ++ txt ++ ";" width txt = "width:" ++ txt ++ ";" height txt = "height:" ++ txt ++ ";" margin txt = "margin:" ++ txt ++ ";" margin_top txt = "margin-top:" ++ txt ++ ";" margin_bottom txt = "margin-bottom:" ++ txt ++ ";" opacity txt = "opacity:" ++ txt ++ ";" float txt = "float:" ++ txt ++ ";" top txt = "top:" ++ txt ++ ";" left txt = "left:" ++ txt ++ ";" position txt = "position:" ++ txt ++ ";" overflow txt = "overflow:" ++ txt ++ ";" text_indent txt = "text-indent:" ++ txt ++ ";" text_align txt = "text-align:" ++ txt ++ ";" white_space txt = "white-space:" ++ txt ++ ";" display txt = "display:" ++ txt ++ ";" line_height txt = "line-height:" ++ txt ++ ";" border_radius txt = "border-radius:" ++ txt ++ ";" letter_spacing txt = "letter-spacing:" ++ txt ++ ";" transition txt = "transition:" ++ txt ++ ";" csscls::String->[String]->String csscls cls props = cls ++ " {\n" ++ (intercalate "\n" props) ++ "\n}\n" tag_canvas txt = "<canvas id='canvas' width='200' height='200'>\n" ++ txt ++ "\n</canvas>" tag_script txt = "<script>\n" ++ txt ++ "\n</script>" -------------------- カスタマイズ部分 -- css設定 css::String css = tag_style (intercalate "\n" [ csscls ".header" [ "width:100%;", padding "28px 0 10px", background "url('./e.png') repeat-x", box_shadow "0 0 10px 1px #e3e3e3" ], csscls ".wrapper" ["width:970px;","margin: 30px auto 40px;"], csscls ".main" ["display:block;","float:left;","width:80%;"], csscls ".sidemenu" ["float:right;","width:20%;"], csscls ".footer" ["width:100%;"], csscls ".clearfix::after" ["content:'';","display:block;","clear:both;"], -- csscls ".header, .main, .sidemenu, .footer" ["border: 1px solid #aaa;","background-color:#ccc;"], -- csscls ".header, .footer" ["height:100px;"], -- csscls ".main, .sidemenu" ["height:500px;"], csscls "html" [fontsize "62.5%"], csscls "body" [color "#333", fontsize "1.2rem", font_family hiragino], csscls "*,*::before *::after" [box_sizing "border-box"], csscls "a:link a:visited a:hover a:active" [color "#d03c56",text_decoration "none"], csscls ".logo" [width "225px", height "56px", margin "0 auto", -- 中央寄せ background "url('./logo.gif') no-repeat", overflow "hidden", -- テキスト隠し text_indent "100%", -- テキスト隠し white_space "nowrap" ], csscls ".logo a" [display "block", -- width,heightの指定をきかせるため(aはこれがinline) width "100%", height "100%"], csscls ".hidden" [display "none"], navicss, maincss ]) --------- html = commonMake "title" css header footer wrapper -- 共通 commonMake title css header footer x = result where result = tag_doctype ++ html html = tag_html (head ++ body) head = tag_head (meta ++ title ++ (tag_link "stylesheet" "reset200802") ++ css) meta = tag_meta "'UTF-8'" title = tag_title "title" body = tag_body (header ++ x ++ footer) -- ヘッダー header::String header = tag_header (logo ++ navi) -- フッター footer::String footer = tag_footer "" -- ラッパー wrapper = tag_div "wrapper clearfix" (maincontents ++ (tag_div "sidemenu" "")) -- ロゴ logo = tag_h1 "logo" (tag_a "" "'/'" "Logo") -- ナビ navi = tag_nav "global-nav" list where list = tag_ul "" (intercalate "\n" contents) where contents = [tag_li "nav-item active" (tag_a "" "#" "HOME"), tag_li "nav-item" (tag_a "" "#" "ABOUT"), tag_li "nav-item" (tag_a "" "#" "NEWS"), tag_li "nav-item" (tag_a "" "#" "TOPICS"), tag_li "nav-item" (tag_a "" "#" "DOCS"), tag_li "nav-item" (tag_a "" "#" "BLOG")] navicss = (intercalate "\n" [center, align_x, link, linkdynamics]) where center = csscls ".global-nav" [margin_top "15px", text_align "center" -- 子も中央寄せになる ] align_x = csscls ".global-nav .nav-item" [ display "inline-block", -- 横に並ぶ margin "0 10px" -- 高さしていいてないのでアイテムの高さはaによる ] link = csscls ".global-nav .nav-item a" [ display "inline-block", -- 幅と高さ指定の有効化 width "100px", height "30px", line_height "30px", -- 行の高さをheightと同じにして縦方向の中央よせ text_align "center", -- 横方向の中央よせ border_radius "8px", color "#666", fontsize "1.3rem", letter_spacing "1px", -- 文字間隔 transition "0.15s" ] linkdynamics = csscls ".global-nav .nav-item.active a, .global-nav .nav-item a:hover" [ background_color "#d03c56", color "#fff" ] -- メイン maincontents = tag_main "main" (hot ++ news ++ articles) where hot = title ++ body where title = tag_h2 "hidden" "HOT TOPIC" body = hottopic news = title ++ body where title = tag_h2 "" "NEWS" body = tag_div "news" newstopic articles = title ++ body where title = tag_h2 "hidden" "ARTICLES" body = tag_div "articles" "内容" -- 子がflowなので親にclearfix付与 hottopic = tag_a "hot-topic clearfix" "#" (intercalate "\n" [image,div]) where image = tag_img "image" "./logo.gif" "画像" div = tag_div "content" content where content = (intercalate "\n" [title,desc,time]) where title = tag_h3 "title" "実務で使えるHTML/CSS<br>モダンコーディングTIPS" desc = tag_p "desc" "Webフロントエンドの進化の勢いは留まるところをしりません。" time = tag_time "date" "2017-06-02" "2017.06.02" maincss = (intercalate "\n" [hottpiccss]) hottpiccss = (intercalate "\n" [common, hover, image, content]) where common = csscls ".hot-topic" [ display "block", height "300px", margin_bottom "30px", box_shadow "0 6px 4px -4px rgba(0,0,0,0.15)", transition "opacity 0.15s" ] hover = csscls ".hot-topic:hover" [ opacity "0.85" ] image = csscls ".hot-topic .image" [ float "left", width "50%", height "100%" ] content = (intercalate "\n" [base, title, desc, date]) where base = csscls ".hot-topic .content" [ float "left", width "50%", height "100%", padding "25px 0", background_color "#2d3d54", position "relative", -- 子は相対座標 line_height "1.6" -- フォントサイズ✕1.6 ] title = csscls ".hot-topic .title" [ margin_bottom "15px", color "#fff", font_weight "normal", fontsize "2.0rem" ] desc = csscls ".hot-topic .desc" [ color "#ddc" ] date = csscls ".hot-topic .date" [ position "absolute", top "0px", left "0px", width "140px", padding "4px", background_color "#fff", color "#2d3d54", letter_spacing "1px", font_weight "bold", fontsize "1.1rem", line_height "1" ] -- news newstopic = tag_ul "scroll-list" items where items = tag_li "scroll-item" (tag_a "" "#" (intercalate "\n" [ newslist "2017-06-01" "2017.06.01 WED" "TOPIC" "CSSでここまでできる！？", newslist "2017-06-02" "2017.06.02 WED" "TOPIC" "CSSでここまでできた！？", newslist "2017-06-03" "2017.06.03 WED" "TOPIC" "CSSでここまでできます！？" ])) newslist datetime datetimestr categorystr titlestr = tag_li "scroll-item" (tag_a "" "#" (intercalate "\n" [time, category, title])) where time = tag_time "date" datetime datetimestr category = tag_span "category" categorystr title = tag_span "title" titlestr
