QuasiQuoteでopen-unionを書きやすくするライブラリを作ってみました

## はじめに

[前回の記事](https://qiita.com/nwtgck/items/03e0817ceda5c4b60957)では、[open-union](https://hackage.haskell.org/package/open-union)を使ってみました。

そこで今回はopen-unionをより書きやすくするために、ちょっとしたライブラリを作ってみたので、紹介します。

## 普通のopen-union

そのままの、open-unionでは、関数を書くときは以下のようにして、型ごとにマッチさせます。きっと型安全でとてもいいのですが、見た目が、通常のパターンマッチングらしくないですよね。

```hs
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}

import Data.OpenUnion


-- 普通のopen-union
showMyUnion :: Union '[Char, Int, [()]] -> String
showMyUnion
    =  (\(c :: Char)   -> "char: " ++ show c)
    @> (\(i :: Int)    -> "int: " ++ show i)
    @> (\(l :: [()])   -> "list length: " ++ show (length l))
    @> (\(s :: String) -> "string: " ++ s)
    @> typesExhausted
```

## open-union-sugarを使ったとき

（[open-union-sugar](https://github.com/nwtgck/open-union-sugar-haskell)が今回紹介するライブラリです）
以下のように`[ptn| ... ]`の中に書けば、普通のHaskellのパターンマッチのように書くことができるようになります。

```hs
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE ScopedTypeVariables #-}

import Data.OpenUnion
import Data.OpenUnion.Sugar

type UnitList = [()]

showMyUnion :: Union '[Char, Int, String, UnitList] -> String
[ptn|
showMyUnion (c :: Char)     = "char: " ++ show c
showMyUnion (i :: Int)      = "int: " ++ show i
showMyUnion (s :: String)   = "string: " ++ s
showMyUnion (l :: UnitList) = "list length: " ++ show (length l)
|]
```

## ヘテロリスト

他にもヘテロリストを簡単につくれる`[hlist| ... |]`などがあります。

```hs
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE QuasiQuotes #-}


import Data.OpenUnion
import Data.OpenUnion.Sugar

main :: IO ()
main = do
    let hlist1 :: [Union '[Char, Bool, String]]
        hlist1 = [hlist|
                    'a'
                  , True
                  , "apple"
                  , 'z'
                  , False
                  , "orange"
                 |]
    print hlist1
    -- => [Union ('a' :: Char),Union (True :: Bool),Union ("apple" :: [Char]),Union ('z' :: Char),Union (False :: Bool),Union ("orange" :: [Char])]

```

## `open-union-sugar`の導入法

Stackをお使いの方は、`stack.yaml`の`extra-deps`に以下を追記すればOKです（`commit:`のところは、その時の最新版にコミットID変更したり、定義変更してください）。

```yaml
...
extra-deps:
- git: git@github.com:nwtgck/open-union-sugar-haskell.git
  commit: 24ad5c35054dc511308bb5186cf17784042c499a
...
```

## 実装について

主なQuasiQuoteの実装は以下の場所にあります。
[src/Data/OpenUnion/Sugar.hs](https://github.com/nwtgck/open-union-sugar-haskell/blob/develop/src/Data/OpenUnion/Sugar.hs)

### `[ptn | ... ]`

`[ptn | ... ]`の構文解析は[haskell-src-meta](https://hackage.haskell.org/package/haskell-src-meta)パッケージの[`Language.Haskell.Meta.Parse`モジュール](https://hackage.haskell.org/package/haskell-src-meta-0.8.0.2/docs/Language-Haskell-Meta-Parse.html)の`parseDecs`を使ってます。

以下のコードは意味解析のときにはエラーですが、構文解析のときはエラーにならないようなので、思ったように構文木を`parseDecs`を使って取得することができました。

```hs
showMyUnion (c :: Char)     = "char: " ++ show c
showMyUnion (i :: Int)      = "int: " ++ show i
showMyUnion (s :: String)   = "string: " ++ s
showMyUnion (l :: UnitList) = "list length: " ++ show (length l)
```

### `[hlist | ... ]`

`[hlist | ... ]`の構文解析には`parseExp`が使われていて、これも`[ptn| ... |]`と同様に、以下のリストは意味解析的にはエラーですが、構文解析にはOKなので、思ったように構文木が手に入りました。

```hs
['a' , True , "apple", 'z', False, "orange"]
```