とりとめのない GHC 線形型メモ

GHC 9.0.1 alpha 1 がリリースされたときに線形型をいじってみていたことをメモしていなかったので思い出しながらメモしていく。

mail.haskell.org

使用バージョン

  • GHC 9.0.0.20200925
    • 上記リンクのもの

ghcup ならそれ経由でインストールできる。

ghcups の場合は手動インストール後、下記のような設定ファイルで切り替えができるようになる1

ghc:
  9.0.1-alpha1: H:\programs\ghc-9.0.0.20200925-x86_64-unknown-mingw32\bin

線形型とは

GHC では引数が1回しか使えない(1回は使わないといけない)関数型として線形型が実装されている。

  • 一般の関数:\displaystyle{a \to b}
  • 線形型の関数:\displaystyle{a \multimap b}

線形型の GHC プロポーザルはこちら

github.com

\displaystyle{a \multimap b}Haskell 文法としては a %1 -> b として書く。

a %1 -> ba %'One -> b の別名で(' は data kinds 拡張のシングルクォート)、a %'One -> bFUN 'One a b の別名となっている。これにともなって a -> bFUN 'Many a b の別名となった。FUN の型は下記のようになっている。

FUN :: Multiplicity -> forall (r1 r2 :: RuntimeRep). TYPE r1 -> TYPE r2

data Multiplicity
  = One    -- represents 1
  | Many   -- represents ω

最終的には上記のようになるようだが 9.0.1 alpha 1 の時点では \displaystyle{a \multimap b}a #-> b と記述する。

a #-> b から a %1 -> b に変わった理由の1つとしては overloaded labels が将来的に型レベルに持ち上げられたときの文法の衝突を回避することがあるらしい。

gitlab.haskell.org

マージ前だと a ->. b の時期もあったようだ。

ちょうど1回

準備ができたらコードを書いてみる。下記コマンドで REPL を起動する。

ghc --interactive -XLinearTypes

まず最初にエラーを起こしてみる。

f :: Int #-> (Int, Int)
f a = (a, a)
<interactive>:3:3: error:
    * Couldn't match type 'Many with 'One
        arising from multiplicity of `a'
    * In an equation for `f': f a = (a, a)

a が2回使用されているので推論される f の型は a -> (a, a) つまり FUN 'Many a (a, a) だが、注釈は Int #-> (Int, Int) つまり FUN 'One Int (Int, Int) なので FUN の第1引数である Multiplicity が不一致だと言っている。

引数を1回も使用しなくても同じエラーとなる。

f :: Int #-> (Int, Int)
f a = (1, 2)
<interactive>:7:3: error:
    * Couldn't match type 'Many with 'One
        arising from multiplicity of `a'
    * In an equation for `f': f a = (1, 2)

ちょうど1回使用するともちろんうまくいく。

f :: Int #-> (Int, Int)
f a = (a, 1)

注釈がない場合、ちょうど1回しか使っていなくても multiplicity は \displaystyle{\omega}(many)となる。multiplicity ポリモーフィズムは今のところない。

Prelude> g a = ((a, 1) :: (Int, Int))
Prelude> :type g
g :: Int -> (Int, Int)

a #-> ba -> b としても使えるというような部分型関係はない。

h :: Int -> (Int, Int)
h = f
<interactive>:21:5: error:
    * Couldn't match type 'One with 'Many
      Expected: Int -> (Int, Int)
        Actual: Int #-> (Int, Int)
    * In the expression: f
      In an equation for `h': h = f

引数を明記すると、これは妥当である。

h :: Int -> (Int, Int)
h a = f a

f = gf a = g a の意味が同じでないというのはこれまでの Haskell の感覚からすると注意が必要なところに思える。

パターンマッチをすると1回使ったとカウントされるので下記のようなコードも妥当である。

consume :: Bool #-> ()
consume False -> ()
consume True -> ()

引数に関係なく返り値が同じだからと次のように書くと、これは引数未使用となるためエラーとなる。これもうっかりまちがえそうだ。

consume :: Bool #-> ()
consume _ -> ()
<interactive>:1:33: error:
    * Couldn't match type 'Many with 'One
        arising from a non-linear pattern
    * In the pattern: _
      In an equation for `consume': consume _ = ()

linear-base

GHC への線形型を提案して実装した Tweag が作っている線形型対応の base パッケージが linear-base で、ここからはそれを使っていく。使用リビジョンは 341007891ae77959ac7b147f008e3a1d9c46e96b である。

github.com

multiplicity ポリモーフィズムはない

multiplicity ポリモーフィズムがないので ($)線形版との使い分けが必要である。

f $ 1 -- error: Couldn't match type ‘'Many’ with ‘'One’ arising from an application
import qualified Prelude.Linear as L
f L.$ 1

現状 case 式は線形型非対応なので case x of … と書くと x は複数回使用したとみなされてしまう。それを回避するために lambda case 拡張2を使ったイディオムが必要となる(参考)。

{-# LANGUAGE LambdaCase #-}
import Prelude.Linear ((&))

maybeFlip :: Int #-> Int #-> (a,a) -> a
maybeFlip i j (x,y) =  i < j & \case
  True -> x
  False -> y

let や where も線形型非対応なので注意が必要である(参考)。

Consumable 型クラス

先述した consume 関数は Data.Unrestricted.Linear モジュールの Consumable 型クラスで提供されている(参考)。

class Consumable a where
  consume :: a #-> ()

Dupable 型クラス

最初の例で2回使えないという話をしたが、アドホックポリモーフィズムを使えば実装できる(参考)。V :: Nat -> Type -> Type は型レベル長さ付きベクトルである(参考)。

-- | The laws of @Dupable@ are dual to those of 'Monoid':
--
-- * @first consume (dup2 a) ≃ a ≃ second consume (dup2 a)@ (neutrality)
-- * @first dup2 (dup2 a) ≃ (second dup2 (dup2 a))@ (associativity)
--
-- Where the @(≃)@ sign represents equality up to type isomorphism.
--
-- When implementing 'Dupable' instances for composite types, using 'dupV'
-- should be more convenient since 'V' has a zipping 'Applicative' instance.
class Consumable a => Dupable a where
  {-# MINIMAL dupV | dup2 #-}

  dupV :: forall n. KnownNat n => a #-> V n a

  dup2 :: a #-> (a, a)

Bool に対する実装は下記になっている。ここで DataData.Functor.Linear.Internal である。

instance Dupable Bool where
  dupV True = Data.pure True
  dupV False = Data.pure False

pure は線形型版アプリカティブファンクターのもので下記の型を持つ。

class Functor f => Applicative f where
  pure :: a -> f a
  …

dupV の引数はパターンマッチで1回しか使っていなくて、pure に渡した TrueFalse は何回でも使えるから pure に渡せて pure は線形関数じゃないから複製ができるということかな。

Ur 型

linear-base で1つキモになる型に Ur 型がある(参考)。

-- | @Ur a@ represents unrestricted values of type @a@ in a linear
-- context. The key idea is that because the contructor holds @a@ with a
-- regular arrow, a function that uses @Ur a@ linearly can use @a@
-- however it likes.
-- > someLinear :: Ur a #-> (a,a)
-- > someLinear (Ur a) = (a,a)
data Ur a where
  Ur :: a -> Ur a

線形型文脈の中に何回も使える普通の値を埋め込む型で、Ur 値構築子の型が a #-> Ur a ではなく a -> Ur a となっているので中身の a 型の値は何回でも使えるようになっている。

追記(2020.12.19)

Ur の定義を下記のようにすると型構築子のカインドも値構築子の型も上記と同じとなるが線形関数と一緒に用いると型検査に違いが出る。
data Ur a = Ur a
下記のような線形関数を考える。
f :: Ur a #-> (a, a)
f (Ur a) = (a, a)
GADT を使った定義だと問題なく型検査が通るが、後者の定義だと下記のエラーが出る。
<interactive>:40:31: error:
    • Couldn't match type ‘'Many’ with ‘'One’
        arising from multiplicity of ‘a’
    • In the pattern: Ur a
      In an equation for ‘f’: f (Ur a) = (a, a)

Movable 型クラス

線形関数の引数を Ur で包む関数をもつのが Movable 型クラスである(参考)。

-- | The laws of the @Movable@ class mean that @move@ is compatible with
-- @consume@ and @dup@.
--
-- * @case move x of {Ur _ -> ()} = consume x@
-- * @case move x of {Ur x -> x} = x@
-- * @case move x of {Ur x -> (x, x)} = dup2 x@
class Dupable a => Movable a where
  move :: a #-> Ur a

Functor・Applicative・Monad 型クラス

linear-base の提供する FunctorApplicative には2種類ある。

まず Data.Functor.Linear.Internal から見ていく。

class Functor f where
  fmap :: (a #-> b) -> f a #-> f b

class Functor f => Applicative f where
  pure :: a -> f a
  (<*>) :: f (a #-> b) #-> f a #-> f b
  liftA2 :: (a #-> b #-> c) -> f a #-> f b #-> f c

もう1つは Control.Monad.Linear.Internal にある。Data は上記の Data.Functor.Linear.Internal である。

class Data.Functor f => Functor f where
  fmap :: (a #-> b) #-> f a #-> f b

class (Data.Applicative f, Functor f) => Applicative f where
  pure :: a #-> f a
  (<*>) :: f (a #-> b) #-> f a #-> f b
  liftA2 :: (a #-> b #-> c) #-> f a #-> f b #-> f c

class Applicative m => Monad m where
  (>>=) :: m a #-> (a #-> m b) #-> m b
  (>>) :: m () #-> m a #-> m a

前者は一部普通の関数だが後者は全部線形関数になっている。

fmap :: (a #-> b)  -> f a #-> f b
fmap :: (a #-> b) #-> f a #-> f b

pure :: a  -> f a
pure :: a #-> f a

liftA2 :: (a #-> b #-> c)  -> f a #-> f b #-> f c
liftA2 :: (a #-> b #-> c) #-> f a #-> f b #-> f c

前者だとモナドっぽいものにならないのかな(よく分かってない)。

ほか

linear-base にはまだ見るべきところがあるようだが、まだ見てないので終わり。User guide に記載の下記などは気になる。

Here's a list of new abstractions made possible by linear types:

  1. Mutable arrays, hashmaps, vectors, sets with a pure API. See Data.Array.Mutable.Linear.
  2. Push and Pull arrays: a way to control when arrays are allocated and force array fusion. See Data.Array.Polarized.
  3. A linear API for system heap (not GC) allocation of values. See Foreign.Marshall.Pure.

Tweag のブログの線形型応用例。なるほどとなった。

www.tweag.io

参考


  1. Windows 版は D ドライブが光学ドライブだとエラーになる(課題)。

  2. GHC の言語拡張は複数形になりがちなのに、lambda case は単数形なんだな。

Windows から Windows コンテナーと Linux コンテナーの両方の Docker を使う

Docker Desktop for WindowsWindows コンテナーと Linux コンテナーが使えるのだけど排他的になっている。

そう思ってスクショを取るために切り替えボタンを押してみたら今はそうじゃない?Windows/Linux コンテナーの切り替え、前は完全に排他的だったと思ったけど、今は実行は両方できるのか?あとホストの再起動要らなくなってる?

Switch to Linux containers ダイアログ

まあ、そもそも Docker Desktop for Windows のコンテナーが排他的なの理由が分からないのよな。

で、両方のコンテナーをいじりたいのでラッパープログラムを作った。その内要らなくなりそうだけど。

イメージ図としては下図のような感じ。

Docker のスタック図

Windows と WSL2 Linux のそれぞれで Docker サーバーを立てて、Windows の Docker クライアントから両方にアクセスする。docker コマンドの --host オプションを使えば接続先のサーバーを選べるので。あとは --volume のパスの変換をしてやる。

下の1行目を実行すると2行目に変換する感じ。

> kb --linux --volume C:\Users\kazuki\:/work run --rm -i hello-world
> docker --host tcp://127.0.0.1:9266 run --volume /mnt/c/Users/kazuki/:/work --rm -i hello-world
> kb --help
Usage: kb [OPTION...] ARGUMENTS
  鯨箱

Options:
  -l               --linux                      Use Linux container
  -w               --windows                    Use Windows container
  -d DISTRIBUTION  --distribution=DISTRIBUTION  Select a distribution on WSL 2
  -s               --setup                      Setup Docker for Kujira Bako
  -V VOLUME        --volume=VOLUME              Mount a volume
  -?               --help                       display this help and exit
  -v[n]            --verbose[=n]                set verbosity level

とりあえずラッパーにしたけど、本来なら Docker Desktop for Windows を改修するのが筋がいいよなあ。Windows コンテナー選択時はこの変換をやってるんだろうし(未確認)。

github.com

参考

blog.amedama.jp

無職になりました

無職になりました。

とりあえず異世界行ったら本気出しますかね。

経緯

経緯としては鬱になって休職をしていたのですが、休職できる期間が9ヶ月だったので満了しました(在職期間によって休職可能期間が変わるようです)。

kakkun61.hatenablog.com

これから

とりあえず失職にともなってもらえるものをもらうための手続きを忘れずにしないといけないですね。

失業のプロの方がいらっしゃればアドバイスください。あと確定申告についても。

健康保険

2年は在職中と同じ健康保険を任意継続できるので、11月14日までに申請をしないといけない。

申請用紙が送付されてくるので、それ待ち。

任意継続しないなら国民健康保険に入るらしいですが、元々ある程度の給料があれば任意継続した方がお得っぽい(よく分かってない)。

ただ、任意継続しても、以前の会社負担分も個人で負担する必要があるので倍の出費になるっぽい(ひえー)。

人の扶養に入って生活するなら、その人の被扶養者となるみたい。

www.kyoukaikenpo.or.jp

失業給付

ハローワークに申請するっぽい。

申請時に離職票が必要で離職後2・3週間したら会社から送付されてくるっぽいのでそれを持ってハローワークに行くっぽい。

人事の人は受けられるっぽいことを言っていたが休養中なので受けられないんじゃないかという気もする。とりあえずハローワーク行って聞いてみよう。

「失業」とは、離職した方が、「就職しようとする意思といつでも就職できる能力があるにもかかわらず職業に就けず、積極的に求職活動を行っている状態にある」ことをいいます。したがって、次のような状態にあるときは、失業給付を受けることができません。

  • 病気やけがのために、すぐには就職できないとき

ハローワークインターネットサービス - 雇用保険の具体的な手続き

あと、同人活動の収入によっては給付対象外になりそう。

本来は、基本手当を受けられないにもかかわらず、虚偽の申告などにより基本手当の支給を受けようとした場合には、不正受給としてそれ以後の支給がすべて停止され、厳しい処分が行われます(他の給付も同様です。)。

次のようなことは、絶対に行わないようにしてください。

  1. 内職や手伝いをした事実や収入を隠したり、偽った申告をする。

ハローワークインターネットサービス - 雇用保険の具体的な手続き

www.hellowork.mhlw.go.jp

医療費控除

医療費控除のこと何も考えてなかったから今年のほとんどの領収書は捨てちゃったな。

税務署に聞きに行く。

損害保険

よく分からない封筒が届いたので会社に聞かなきゃいけない。

確定申告

確定申告もしないといけない。来年3月に前年分の申請をするんだっけ?よく分かってない。

これも税務署に聞きに行く。

そのあと

とりあえず年末年始を避けて11月中に一時帰省しようかと思っています。

ゴートゥートラベルやらうまく使えるんだろうか?

結局これもよく分かってないな。

最後に

物的支援をよろしくお願いします!前回ご支援いただいた方々ありがとうございました!

ウィッシュリスト(食品・日用品)

ウィッシュリスト(趣味)

Data.Monoid.First と Data.Semigroup.First あるいは Last

Data.Monoid.First のドキュメントを見ていたら次の記述を見つけたことから始まる記事です。

This type will be marked deprecated in GHC 8.8, and removed in GHC 8.10. Users are advised to use the variant from Data.Semigroup and wrap it in Maybe.

すでに GHC 8.10 がリリースされているのにまだなくなっていない気がしますが(GHC 9.0.1-alpha1 にもまだある)、Data.Monoid.First よりも Data.Semigroup.First を使うべきなようです。

追記(2020.11.01)

id:maoe さんに教えていただき、現在はこの deprecation は撤回されたそうです。 mail.haskell.org gitlab.haskell.org

以降、次のようにモジュールを参照します。

> import qualified Data.Semigroup as S
> import qualified Data.Monoid as M

復習

セミグループの復習として、文字列とその結合を見ると次のような挙動をします。

> "a" <> "bc"
"abc"
> "" <> "abc"
"abc"

モノイドの単位元"" です。

> mempty <> "abc"
"abc"

Data.Semigroup.First

さてここにセミグループのインスタンスでない型 Char があります。

> 'a' <> 'b'
<interactive>:13:1: error:
    • No instance for (Semigroup Char) arising from a use of<>’
    • In the expression: 'a' <> 'b'
      In an equation for ‘it’: it = 'a' <> 'b'

Data.Semigroup.First にくるめばセミグループになります。

> S.First 'a' <> S.First 'b'
First {getFirst = 'a'}

左が返り値となります。

Data.Monoid.First

では Data.Monoid.FirstChar をくるめるでしょうか?

> M.First 'a'
<interactive>:16:9: error:
    • Couldn't match expected type ‘Maybe a’ with actual type ‘Char’
    • In the first argument of ‘M.First’, namely ‘'a'’
      In the expression: M.First 'a'
      In an equation for ‘it’: it = M.First 'a'
    • Relevant bindings include
        it :: M.First a (bound at <interactive>:16:1)

Data.Monoid.First でくるめるのは Maybe a だけです。

> M.First $ Just 'a'
First {getFirst = Just 'a'}

Just 同士の演算は Data.Semigroup.First と同じです。

> M.First (Just 'a') <> M.First (Just 'b')
First {getFirst = Just 'a'}

Nothing がからむと Nothing でない最初の要素が返ります。

> M.First Nothing <> M.First (Just 'a') <> M.First (Just 'b')
First {getFirst = Just 'a'}

Data.Maybe

Data.Maybe はモノイドとしては次のような挙動が採用されています(雑になってきた)。

> Nothing <> Nothing
Nothing
> Nothing <> Just "a"
Just "a"
> Just "a" <> Nothing
Just "a"
> Just "a" <> Just "b"
Just "ab"

Maybe aa はモノイドである必要があります。

もういちど Data.Semigroup.First

最初の引用を再掲します。

This type will be marked deprecated in GHC 8.8, and removed in GHC 8.10. Users are advised to use the variant from Data.Semigroup and wrap it in Maybe.

というわけで Data.Monoid.First の代わりに Data.Semigroup.First を使うように置き換えてみます。

元々の Data.Monoid.First を次に再掲します。

> M.First Nothing <> M.First (Just 'a') <> M.First (Just 'b')
First {getFirst = Just 'a'}

なんか M.First Nothing が無視されるのはただの Nothing っぽいので Maybe ? という形になりそうです(ほんまか?)。

Maybe ? の演算は ? の演算をして Just にくるむので ? は左を選ぶやつにすればいいようです。

Data.Semigroup.First がそれなので、M.First a ≡ Maybe (S.First a) になりそうです。

……というのがドキュメントに書いてました。

Note the following equivalence: Data.Monoid.First x === Maybe (Data.Semigroup.First x)

動的型付けインタープリター言語 Haskell

  • コンパイルを待つなんて生産性が低い!
  • 通らないコード片のエラーなんか知らない!

えっ?!まだ静的型検査してコンパイルしてるの?

デキるプログラマーは動的型検査!インタープリット!

main = do
  input <- readLn
  if input < 10
    then putStrLn "Hi"
    else putStrLn ("Bad" + input)

このコードを実行するにはどうしてる?まさかこうしてる?

> ghc main.hs

main.hs:5:21: error:
    • No instance for (Num [Char]) arising from a use of ‘+’
    • In the second argument of ‘($)’, namely ‘"Bad" + input’
      In the expression: putStrLn $ "bad" + input
      In a stmt of a 'do' block:
        if input < 10 then putStrLn "Hi" else putStrLn $ "Bad" + input
  |
5 |     else putStrLn $ "Bad" + input
  |

うーん、input が10か10より大きいと確かに "Bad" + input でエラーになるね。でも、input が10より小さいと?大丈夫じゃん!動かしちゃおうよ!

どうするかって?こうするんだよ!

> ghc -fdefer-type-errors -Wno-deferred-type-errors main.hs
[1 of 1] Compiling Main             ( main.hs, main.o )
Linking main.exe ...
> .\main
9
Hi

やったぜ!

でもリンクの時間が長くない?そのまま動かした方がよくない?いいよね!

> runghc --ghc-arg=-fdefer-type-errors --ghc-arg=-Wno-deferred-type-errors main.hs
9
Hi

ばっちりだ!

みんなも動的型付けインタープリター言語である Haskell をやっていこうな!

f:id:kakkun61:20201023183605p:plain

GitHub Actions のアクションとして同一リポジトリーで定義した Docker イメージを使う

この記事では GitHub Actions のアクションとして同一リポジトリーで定義した Docker イメージを使う方法を説明します。

GitHub Actions のワークフローで Docker イメージをビルドする方法などは扱いません。

ここでアクションとワークフローの単語を次のように使い分けます。

  • アクション
    • …/action.yaml で定義する
    • ワークフローから参照される
  • ワークフロー
    • /.github/workflows/….yaml で定義する
    • アクションを参照する

まずリポジトリーのディレクトリー構成を示します。

  • /
    • .docker
      • Dockerfile
      • entrypoint.sh
    • .github
      • actions
      • workflows

次にそれぞれのファイルの役割を説明します。

/.docker/Dockerfile

イメージを定義する Dockerfile です。/.dockerディレクトリーは任意です。どこでも構いません。

Dockerfile の中身は次のようにしました。

FROM pandoc/ubuntu:2.10.1

COPY entrypoint.sh /

RUN chmod +x /entrypoint.sh

ENTRYPOINT ["/entrypoint.sh"]

/.docker/entrypoint.sh

コンテナー内で実行するスクリプトです。

#! /bin/sh

set -e

echo "Hello, $1!"

/.github/actions/hello/action.yaml

アクションを定義するファイルです。/.github/actions/helloディレクトリーは任意ですが、action.yaml の直上までがアクションの識別子となります。この場合は /.github/actions/hello が識別子です。

name: hello

description: say hello

inputs:
  whom:
    description: who to say hello
    required: true
    default: world

runs:
  using: docker
  image: ../../../.docker/Dockerfile
  args:
    - ${{ inputs.whom }}

usingdocker を指定することでアクションとして Docker イメージを使用できます。inputs でアクションの引数を定義し、runs.argsdocker run 時の引数として渡しています。

/.github/workflows/build.yaml

ワークフローを定義するファイルです。/.github/workflows/….yaml の形式のパスになります。

on : push

jobs:
  build:
    runs-on: ubuntu-latest
    steps:
      - uses: actions/checkout@v2
      - uses: ./.github/actions/hello
        with:
          whom: Kazuki

jobs.….steps.uses に先ほど定義したアクションの識別子を指定します。

これで、GitHub Actions のワークフローで Docker イメージをビルドしてコンテナーを起動し実行することができます。

ちなみに Docker Hub にアップロードされたイメージを利用する場合は下記のように書けます。

jobs:
  build:steps:- uses: docker://alpine:3.8
      …

参照

docs.github.com

アクションとワークフローを別のリポジトリーにする場合は上記で解説されています。

docs.github.com

同一リポジトリー内に定義したアクションを参照する方法は上記で解説されています。

docs.github.com

GitHub Actions のアクションとする場合の Dockerfile の書き方は上記で解説されています。

docs.github.com

action.yaml の文法と意味については上記で解説されています。

docs.github.com

/.github/workflows/….yaml の文法と意味については上記で解説されています。

shake + lucid + hint で静的ウェブサイト生成

The English version is at Dev.


同人活動用のウェブサイトがあって今までは Jekyll で生成していました。これを Shake + Lucid + Hint で作成した生成器に置き換えました。

doujin.kakkun61.com

shakebuild.com

hackage.haskell.org

hackage.haskell.org

ソースコードはこちらです。

github.com

経緯

GitHub Pages をホストに選択したので最初は自然に Jekyll を選びました。レールに乗っているうちはいいのですが外れたことをしようとすると難しくなってきました。

どうレールを外れようとしたのかを説明するためにウェブサイトの説明をします。このウェブサイトは自サークルで発行した同人誌の紹介をするもので、同人誌ごとのページとそれを一覧するページから成ります。同人誌は即売会で頒布するためそれぞれの同人誌には即売会の情報が付随します。そうなると、ある即売会でどの同人誌が頒布されたかを表示したくなりました。つまり、即売会ごとのページとそれを一覧するページが欲しくなりました。これを実現するのは Jekyll では難しくありました*1

最初にサイトを作成したのが2018年1月ごろで、その後すぐに別のものに移ろうと Hakyll を触ったりしたのですが Hakyll の API の設計は好きになれず結局放置していました。

それでしばらく移行計画は頓挫していたのですが GHC のビルドシステムに Shake が使われているのを見てこれを使えるのじゃないかと思いました。そして調べたら Shake を利用した静的サイト生成器として RibSlick がありました。

API の好みから Slick を利用してみて、自分に必要のない部分を削いでいったらほとんど Slick がなくなったので Shake を直接使うようになりました。

構成

下記が概要図でこれからこれについて説明していきます。

f:id:kakkun61:20200925234250p:plain

まずコンテンツの変更をするたびに GHC でのコンパイルとリンクをするのは時間がかかるのでやりたくありません。そこで Haskell インタープリターを組み込むことにしました。そのライブラリーが Hint です。

流れとしては、Shake を使ってルールを書き、Hint でインタープリターを埋め込んで、実行ファイル gen を作ります。そして gen を実行してコンテンツの Haskell ソースや画像などを読み込み HTML などに変換して出力します。

Data.hs は gen の生成にも、gen が実行するインタープリターからも使うので両方から読み込みます。

Shake のルールには Make のように成果物を指定して依存解決する「後向き」と、ソースを指定する「前向き」とがあります。今回は前向きを使用しています。「前向き」の場合は別途 Filesystem Access Tracer(fsatrace)が必要です。

実装

ディレクトリー構成は次のようにしました。

  • app
    • gen.hs — 生成器本体
  • content
    • book
      • xxx.hs — 同人誌ごとのページ
    • image
    • lib
      • Layout.hs — コンテンツを囲むレイアウト
    • style
    • xxx.hs — その他のページ
  • lib
  • doujin-site.cabal

gen のさわりはこの辺りです。

lucid :: forall p r. (Show p, Typeable r) => FilePath -> FilePath -> p -> Shake.Action r
lucid source destination param = do
  libs <- Shake.getDirectoryFiles "content/lib" ["*.hs"]
  result <- liftIO $ Hint.runInterpreter $ do
    Hint.set [Hint.languageExtensions := [Hint.DuplicateRecordFields, Hint.OverloadedStrings]]
    Hint.loadModules $ ("content" </> source) : (("content/lib" </>) <$> libs)
    Hint.setTopLevelModules ["Main"]
    Hint.setImports ["Data.Functor.Identity", "Lucid", "Data.Text"]
    Hint.interpret ("render (" ++ show param ++ ")") (Hint.as :: Lucid.Html r)
  case result of
    Left e  -> do
      liftIO $ hPutStrLn stderr $ displayException e
      fail "interpret"
    Right html -> do
      Shake.writeFile' ("out" </> destination) $ show html
      pure $ runIdentity $ Lucid.evalHtmlT html

大して難しいことはしていませんが、1つ制約があって、それは show param の結果が妥当な Haskell コードになっていることです。自動導出していれば問題ないはずですが、自前で show を実装していると動作しないかもしれません。

コンテンツの Haskell ソースは render :: Typeable r => p -> Html r を露出していることにしています。book/xxx.hs は下記の形をしています。

{-# LANGUAGE OverloadedStrings #-}

import           Data
import qualified Layout as L

import Lucid

render path = do
  L.top (L.ogp ogp) $ L.book book (Just content)
  pure book
  where
    ogp = …
    book = …
    content =

返り値の Book はそれぞれのページの分が集められた後 index.hs に渡され一覧ページの作成に使用されます。

{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns        #-}
{-# LANGUAGE OverloadedStrings     #-}

import           Data
import qualified Layout as L

import Data.Foldable as F
import Lucid

render (path, books) =
  L.top
    (L.ogp ogp)
    $ div_ [class_ "home"] $ do
        ul_ [class_ "book-list"] $ do
          F.for_ books $ \(Book { title, bookImage, events }, path) -> do
            li_ $ do
              h3_ $
                a_ [class_ "post-link", href_ path] $ toHtml title
              div_ [class_ "justify-bottom"] $ do
                ul_ [class_ "event-badges"] $ do
                  F.for_ events $ \Event { title } -> do
                    li_ [class_ "event-badge"] $ toHtml title
                    " "
                a_ [href_ path] $ img_ [src_ bookImage, alt_ "book image", class_ "home-book-front"]
  where
    ogp =

HTML の記述には Lucid を使用しました。内部 DSL なのでHaskell コードと統一した記法で埋め込めるので楽です。ここは好みで取り替えができます。

ここまで来れば即売会ページとその一覧ページを作るのも簡単そうです。

まとめ

  • Shake を依存関係記述に使う
  • Hint でインタープリターを埋め込む
  • Lucid で HTML を記述する
    • EDSL なので統一した記法で書ける

感想としては、型にはまったフレームワークでコンテンツを書くよりも、パーツとしてのライブラリーを組み合わせて作る方が柔軟性が高くて好みだなと再確認しました。

追記

2020.09.27

テンプレートリポジトリーにしました。

github.com

*1:少なくとも当時の Jekyll では。