Rodhos Soft

備忘録を兼ねた技術的なメモです。Rofhos SoftではiOSアプリ開発を中心としてAndroid, Webサービス等の開発を承っております。まずはご相談下さい。

htmlを吐き出す3

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

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

htmlを吐き出す2

html吐き出すコード、DivTag DIVとか書くのはおかしい。もっとまとまるはず。。

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

tag_doctype = "<!DOCTYPE html>"

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

htmlbody = DivTag (DIV (PTag (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 =HTMLTag HTMLTAG
          |HeadTag HEADERTAG
          |BodyTag BODYTAG
          |TitleTag TITLETAG
          |DivTag DIVTAG
          |PTag PTAG
          |String String

instance TransString TAG where
  string (HeadTag tag) = string tag
  string (BodyTag tag) = string tag
  string (TitleTag tag) = string tag
  string (DivTag tag) = string tag
  string (PTag tag) = string tag
  string (String txt) = txt


data HTMLTAG = HTML { htmlText::[TAG]}
instance TransString HTMLTAG where
  string (HTML { htmlText=tags}) =  tag "html" (stringjoin tags)

data HEADERTAG = HEAD { headTag::TAG}
instance TransString HEADERTAG where
  string (HEAD { headTag=tag_}) = tag "head" (string tag_)

data BODYTAG = BODY { bodyTag::TAG}
instance TransString BODYTAG where
  string (BODY { bodyTag=tag_}) = tag "body" (string tag_)

data TITLETAG = TITLE { titleTag::TAG}
instance TransString TITLETAG where
  string (TITLE { titleTag=tag_}) = tag "title" (string tag_)

data DIVTAG = DIV { divTag::TAG}
instance TransString DIVTAG where
  string (DIV { divTag=tag_}) = tag "div" (string tag_)

data PTAG = P { pTag::TAG}
instance TransString PTAG where
  string (P {pTag=tag_}) = tag "p" (string tag_)

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

最初

processing.jsをダウンロードして配置する。
Processing.js


htmlを用意

<!DOCTYPE html>
<html lang="ja">
  <head>
    <meta charset="UTF-8">
    <title>title</title>
    <script src="./processing.js"></script>
  </head>
  <body>
  <canvas data-processing-sources="./proc.pde"></canvas>
  </body>
</html>

proc.pdeファイルを用意してそこにprocessingの文法で描画すればOK。例として丸を多数動かす。

int MAX = 100;
Target[] targets = new Target[MAX]; // 丸クラス

// 準備はここに描く
void setup() {
  size(1000, 1000); // サイズ指定
  frameRate(20); // 動きのフレームレート指定
  stroke(255, 0, 0); // 塗る色指定

// 丸の生成
  for (int i=0;i<MAX;i++) {
    targets[i] = new Target(random(0,1000),random(0,1000),random(-3.0,3.0),random(-3.0,3.0));
  }
}

// 描画処理はここに描く。フレームレートに応じて都度呼ばれる。
void draw() {
// 消す
  background(0);
// それぞれの丸に命令して描画させる。
  for (int i=0;i<MAX;i++) {
    Target target = (Target)targets[i];
    target.move();
    target.draw();
  }
}

// 丸
class Target {
  float x,y;
  float vx,vy;
  int id;

// 初期化
  Target(float xx, float yy, float vxx, float vyy) {
    x = xx;
    y = yy;
    vx = vxx;
    vy = vyy;
  }

// 移動
  void move() {
    x += vx;
    y += vy;
    if (x > 1000) {
      vx = abs(vx) * -1
    }
    if (x < 0) {
      vx = abs(vx)
    }

    if (y > 1000) {
      vy = abs(vy) * -1
    }
    if (y < 0) {
      vy = abs(vy)
    }
  }

// 描画
  void draw() {
    ellipse(x,y,10,10);
  }
}

ちなみにchromeからだとfile:を参照できなかったのでsafariで実行は確認した。

グラデーション

こちらのやり方にしたがってやってみた。

ics.media


しかし値の調節にこつがいるのかもしれない。

<!DOCTYPE html>
<html>
<head>
	<meta charset="utf-8">
	<style>
		body {
		}
		#bg {
      position: absolute;
			top: 0;
			left: 0;
			width: 100%;
			height: 100%;
			/* 背景グラデーションの作成 */
			background: linear-gradient(to bottom,
			hsl(110, 80%, 40%), /* 色相80(360度中) 彩度 80% 輝度 40%*/
			hsl(170, 80%, 60%), /* 色相140 */
			hsl(230, 80%, 40%)); /* 色相200 */
			background-size: 400% 400%; /* 画面からはみ出させることで変化をみせてる */
      animation: AnimationName 10s ease infinite;
		}
		@keyframes AnimationName {
			0% { background-position: 50% 0% }
			50% { background-position: 50% 100%	}
			100% { background-position: 50% 0% }
		}
	</style>
</head>
<body>
<div id = "bg"></div>
</body>
</html>

flexbox

flexboxを用いて、タイル表示をしてみる。以下を参考にした。
ics.media


HTMLはヘッダーにメニューとmainにタイルとしてdivを置いた。

<!DOCTYPE html>
<html lang="ja">
  <head>
    <meta charset="UTF-8">
    <title>title</title>
    <link rel="stylesheet" type="text/css" href="sample.css">
  </head>
  <body>

  <header>
    <img src="hoge.png" alt="">
    <ul>
      <li><a href="">item1</a></li>
      <li><a href="">item2</a></li>
      <li><a href="">item2</a></li>
    </ul>
  </header>


  <main>
    <!-- カード的なUI  -->
    <div class="animal">
      <h1>うなぎ</h1>
      <img src="images/unagi.jpg" alt="">
      <p>全身がなめらかな皮で覆われている魚である。</p>
    </div>

    <div class="animal">
      <h1>イルカ</h1>
      <img src="images/iruka.jpg" alt="">
      <p>魚のようだが哺乳類である。かしこい。</p>
    </div>

    <div class="animal">
      <h1>いわし</h1>
      <img src="images/iwashi.jpg" alt="">
      <p>最近高くなった。</p>
    </div>

    <div class="animal">
      <h1>どじょう</h1>
      <img src="images/dojou.jpg" alt="">
      <p>もはや見かけない</p>
    </div>
  </main>

  </body>
</html>

レイアウトでflexを用いて均等に配置等を指定する。下記で主軸といっているのが横で交差軸と言ってるのが縦の設定と思えば良い。

/*
 flexには主軸と交差軸という概念
 初期設定では主軸が左から右、交差軸が上から下
*/

/* 主軸を均等割りに */
/* 交差軸を中央に */
header {
  display: flex;
  justify-content: space-between; 
  align-items: center;
}

/* 主軸設定
  flex-start,center,flex-end,space-between(両端は端につく),space-around(両端はボックスの半分)
  交差軸設定
  stretch(親と同じ高さ),flex-start,center,flex-end
*/

/* 交差軸を中央に */
ul {
  display: flex;
  justify-content: space-between; 
  align-items: center;
}


main {
  display: flex;
  flex-wrap: wrap;  /* 複数行配置 */
}

main div.animal {
  width: calc(33.3% - 10px);
  margin: 5px;
}

HTMLヘルパーでテーブルを作る

テーブルをガリガリと書く方法とHTMLヘルパーを使って各方法を2つ並べて書いてみた。

<h1> データ </h1>
<table>
  <thead>
    <tr>
      <th>ID</th>
      <th>NAME</th>
      <th>TITLE</th>
      <th>CONTENT</th>
    </tr>
  </thead>
  <tbody>
    <?php foreach ($data as $obj): ?>
      <tr>
        <td> <?= $obj->id ?> </td>
        <td> <?= h($obj->name) ?></td>
        <td> <?= h($obj->title) ?></td>
        <td> <?= h($obj->content) ?></td>
      </tr>
    <?php endforeach; ?>
  </tbody>
</table>

<table>
  <thead>
    <tr>
      <th>ID</th>
      <th>NAME</th>
      <th>TITLE</th>
      <th>CONTENT</th>
    </tr>
  </thead>
  <?php
  $arr = $data->toArray();// 配列に取り出す
  for ($i = 0 ; $i < count($arr); $i++) {
    echo $this->Html->tableCells(
      $arr[$i]->toArray(),
      ['style' => 'background-color:#f0f0f0'],
      ['style' => 'font-weight:bold'],
      true);
  }
  ?>
</table>

PHPフレームワーク CakePHP 3入門

SQLiteの用意

CakePHPはデータベースやテーブルの設定を自分でする必要がある。大変面倒だがまずSQLiteでやってみることにする。

アプリ(例hoge)内にdbフォルダを作る(hoge/db)。

SQLiteのデータベースを作成する。

sqlite3起動

$ sqlite3 mydata
sqlite> create table 'boards' ( 'id' integer primary key autoincrement, 'name' text not null, 'title' text, 'content' text);

tableができたことを確認

sqlite> .tables
boards
sqlite> .schema boards
CREATE TABLE 'boards' ( 'id' integer primary key autoincrement, 'name' text not null, 'title' text, 'content' text);

ダミーレコードをいれておく。

sqlite> insert into 'boards' values (1,'name','test','test!');
sqlite> insert into 'boards' values (2,'name2','test2','test?');

確認

sqlite> select * from 'boards';
1|name|test|test!
2|name2|test2|test?

データベースの設定 Config/app.php

そのDatasourcesという連想配列をいじる。

<?-
// 略
    'Datasources' => [
        'default' => [
            'className' => 'Cake\Database\Connection',
            'driver' => 'Cake\Database\Driver\Mysql', // ここをSqliteに
            'persistent' => false,
            'host' => 'localhost', // 消す
            //'port' => 'non_standard_port_number',
            'username' => 'my_app', // 消す
            'password' => 'secret', // 消す
            'database' => 'my_app', // ROOT . DS . 'db' . DS . 'mydata' とする(使うファイル名を、拡張子あるならそれをつけて)。DSはパス区切りを表す。
            'encoding' => 'utf8',
            'timezone' => 'UTC',
            'flags' => [],
            'cacheMetadata' => true,
            'log' => false,

            'quoteIdentifiers' => false,

            //'init' => ['SET GLOBAL innodb_stats_on_metadata = 0'],

            'url' => env('DATABASE_URL', null),
        ],

// 略

    ],
->


これでアプリ名にアクセス(例  ***/hoge)でwelcomeページをみて、下の方のdatabaseの項目が「CakePHP is able to connect to the database.」にチェックがついていることを確認する。

エンティティクラスの作成

src/Model/EntityにBoard.phpファイルを作成

<?php
namespace App\Model\Entity;

use Cake\ORM\Entity;

class Board extends Entity {
  // 値の一括代入用の設定 id以外のすべては一括代入可能
  protected $_accessible = [
    '*' => true,
    'id' => false
  ];
}

?>

テーブルクラスのファイルを作成

src/Model/TableにBoardsTable.phpファイルを作成

<?php 
  namespace App\Model\Table;

  use Cake\ORM\Table;

  class BoardsTable extends Table {
    
  }

 ?>

コントローラの作成

<?php
namespace App\Controller;

class BoardsController extends AppController {
  public function index() {
    $data = $this->Boards->find('all'); // $dataはQueryクラス
    $this->set('data', $data);
  }
}
?>

ビューの作成

src/Template内にBoardsフォルダを作成、index.ctpファイルを作る。

<h1> データ </h1>
<table>
  <thead>
    <tr>
      <th>ID</th>
      <th>NAME</th>
      <th>TITLE</th>
      <th>CONTENT</th>
    </tr>
  </thead>
  <tbody>
    <?php foreach ($data as $obj): ?> <!-- $objはBoardエンティティクラス -->
      <tr>
        <td> <?= $obj->id ?> </td>
        <td> <?= h($obj->name) ?></td>
        <td> <?= h($obj->title) ?></td>
        <td> <?= h($obj->content) ?></td>
      </tr>
    <?php endforeach; ?>
  </tbody>
</table>

これで表示まで一通りできた。


PHPフレームワーク CakePHP 3入門

モデル = テーブル+エンティティ

CakePHPのモデルとはテーブルとエンティティの全体を指して使う。以下のようなモデルを作ろう。

識別用のIDを持ち、投稿者名とタイトルと投稿内容を持っている情報(エンティティ)とそのエンティティの集団(テーブル)。
このモデルを「Board」と名付けよう。命名規則的には以下のような命名となる。

  1. モデル Board キャメル記法
  2. データベーステーブル boards 小文字複数形 アンダースコア記法(クラスでないので)
  3. エンティティクラス Board (Board.php) キャメル記法(クラスなので)
  4. コントローラクラス BoardsController (BoardController.php) キャメル記法(クラスなので)
  5. ビュー(テンプレート) Template/Boardsフォルダにindex.ctp等を配置

フォームヘルパーを使う

テンプレートに次のように記述。

  <p> ヘルパーを使ったフォームの送信</p>

    <p>
      <?= $result; ?>
    </p>

    <!-- FormHelperクラスを使ってformタグ生成 第1引数は値を保管するモデル名だが指定していないのでnull-->
    <?= $this->Form->create(null,
    ['type' => 'post',
    'url' => ['controller' => 'Hello', 'action' => 'index']]) ?>
    <!-- inputタグ生成 フィールド名を指定、HelloFormのところはモデル名を指定していればそれを入れる -->
    <?= $this->Form->text("HelloForm.text1") ?>

    <!-- 送信ボタンタグ -->
    <?= $this->Form->submit("送信") ?>

    <!-- タグの終了 -->
    <?= $this->Form->end(); ?>

controller側

<?php
  namespace App\Controller;

  class HelloController extends AppController {

// 略

    public function index() {

// 略

      $result = "";
      if ($this->request->isPost()) {
        $result = "<pre>送信情報<br/>";
        foreach ($this->request->data['HelloForm'] as $key => $value) {
          $result .= $key . ' => ' . $value;
        }
        $result .= "</pre>";
      } else {
        $result = "送信してください";
      }
      $this->set("result", $result);
    }

// 略


  }
?>

AppController->request連想配列

AppControllerのrequestはCakeRequestクラス。

request[種類][キー]で情報が取得できる。

種類は

  1. params 送信された値すべて
  2. data POSTされた際の内容
  3. query クエリー
  4. url 送信アドレス
  5. base ベースのディレクト
  6. webroot webrootディレクト
  7. here 現在のアドレス


PHPフレームワーク CakePHP 3入門

フォーム

フォームをテンプレートに用意

    <form method="get" action="/hello/sendForm">
      <input type="text" name="text1" />
      <inout type="submit" />
    </form>

フォームを送った先

<h1>送信結果</h1>
<p><?=$result ?></p>

ファイル名はsend_form.ctpとする。クラス、メソッド名はキャメル記法なのに対し、アンダースコア記法であることが注意するところ。

コントローラにhello/sendFormのアクションを書く

<?-
  class HelloController extends AppController {
//略
    public function sendForm() {
      $str = $this->request->query['text1']; //getで送ったものはquery連想配列に入っている。
      $result="empty.";
      if ($str != "") {
        $result = "you type:" . $str;
      }
      $this->set("result", $result);
    }
  }
->

フォームを通してでなくても

snedForm?text1=hoge

でも送れる。

ただし、XSS攻撃回避策としてタグを無効化するエスケープ処理を入れる必要がある。それには

<?=
      $this->set("result", htmlspecialchars($result));
=>

とする。

省略記法として

<?=
      $this->set("result", h($result));
=>
でも良い。

PHPフレームワーク CakePHP 3入門

単にテンプレート的に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

htmlを吐き出してみる。

データ型と型クラスを使って少しまとめてみた。
同じようなコードを書かなくてはいけなくて面倒に感じる。
良い方法はないのだろうか。

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

tag_doctype = "<!DOCTYPE html>"

html = string (HTML [header,body])
header = HeadTag (HEAD "OK!")
body = BodyTag (BODY (htmlbody ++ scriptpart))

htmlbody = foldr (++) "" [tag_p "hello", tag_div (tag_canvas ""), string (A "https://www.yahoo.co.jp/" "Link") ]
scriptpart = tag_script scriptlist


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 = HeadTag HEADERTAG
          |BodyTag BODYTAG
          |TitleTag TITLETAG

instance TransString TAG where
  string (HeadTag tag) = string tag
  string (BodyTag tag) = string tag
  string (HeadTag tag) = string tag

data HTMLTAG = HTML { htmlText::[TAG]}
instance TransString HTMLTAG where
  string (HTML { htmlText=tags}) =  tag "html" (stringjoin tags)

data HEADERTAG = HEAD { headText::String}
instance TransString HEADERTAG where
  string (HEAD { headText=txt}) = tag "head" txt

data BODYTAG = BODY { bodyText::String}
instance TransString BODYTAG where
  string (BODY { bodyText=txt}) = tag "body" txt

data TITLETAG = TITLE { titleText::String}
instance TransString TITLETAG where
  string (TITLE { titleText=txt}) = tag "title" txt

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

tag_div txt = "<div>" ++ txt ++ "</div>"
tag_canvas txt = "<canvas id='canvas' width='200' height='200'>" ++ txt ++ "</canvas>"
tag_p txt = "<p>" ++ txt ++ "</p>"
tag_script txt = "<script>" ++ txt ++ "</script>"

assign v e = v ++ " = " ++ e
variable v = "var " ++ v
action target message = " " ++ target ++ "." ++ message
func name v = name ++ "(" ++ v ++")"
quo el = "'" ++ el ++  "'"
getElement el= action "document" (func "getElementById" (quo el))
jsfunc funcname input block = "function " ++ funcname ++ "(" ++ input  ++ ")" ++ block

canvas = "canvas"
context = "context"
sc1 = assign (variable canvas) (getElement canvas)
sc2 = assign (variable context)  (action canvas (func "getContext" (quo "2d")))
sc3 = assign (variable "cx") "100"
sc4 = assign (variable "cy") "100"

sc5 = action context (func "beginPath" "")
sc6 = assign "context.strokeStyle" "'#ff0000'"
sc7 = action context (func "arc" "120, 80, 70, 0, Math.PI*2, false")
sc8 = action context (func "stroke" "")

--jsfunc "drawFillRect" "cx,cy,w,h" (action context (func "fillRect" "cx-w/2, cy-h/2, w, h"))

-- sc9 = "drawFillRect(10,10,40,40)"

scriptlist = intercalate ";" [sc1,sc2,sc3,sc4,sc5,sc6,sc7,sc8]

お絵かき

haskellでお絵かきをするhtmlのコードを無理やり吐き出させてみた。もっとスマートにやれるはず。。

import Data.List
main = print tag_doctype


tag_doctype = "<!DOCTYPE html>" ++ html
html = tag_html (tag_header (tag_title "OK!") ++ tag_body (tag_p "hello")  ++ tag_div (tag_canvas "") ++ tag_script scriptlist)

tag_html txt = "<html>" ++ txt ++ "</html>"
tag_header txt = "<head>" ++ txt ++ "</head>"
tag_body txt = "<body>" ++ txt ++ "</body>"
tag_title txt = "<title>" ++ txt ++ "</title>"

tag_div txt = "<div>" ++ txt ++ "</div>"
tag_canvas txt = "<canvas id='canvas' width='200' height='200'>" ++ txt ++ "</canvas>"
tag_p txt = "<p>" ++ txt ++ "</p>"
tag_script txt = "<script>" ++ txt ++ "</script>"

assign v e = v ++ " = " ++ e
variable v = "var " ++ v
action target message = " " ++ target ++ "." ++ message
func name v = name ++ "(" ++ v ++")"
quo el = "'" ++ el ++  "'"
getElement el= action "document" (func "getElementById" (quo el))
jsfunc funcname input block = "function " ++ funcname ++ "(" ++ input  ++ ")" ++ block

canvas = "canvas"
context = "context"
sc1 = assign (variable canvas) (getElement canvas)
sc2 = assign (variable context)  (action canvas (func "getContext" (quo "2d")))
sc3 = assign (variable "cx") "100"
sc4 = assign (variable "cy") "100"

sc5 = action context (func "beginPath" "")
sc6 = assign "context.strokeStyle" "'#ff0000'"
sc7 = action context (func "arc" "120, 80, 70, 0, Math.PI*2, false")
sc8 = action context (func "stroke" "")

--jsfunc "drawFillRect" "cx,cy,w,h" (action context (func "fillRect" "cx-w/2, cy-h/2, w, h"))

-- sc9 = "drawFillRect(10,10,40,40)"

scriptlist = intercalate ";" [sc1,sc2,sc3,sc4,sc5,sc6,sc7,sc8]