extensible/バリアント

バリアントは、同じ型でも、内部の値が色々な型を持ちうるような構造である。

code: (hs)

data Color

= RGB Int Int Int

| CMYK Int Int Int Int

上記のデータ型の定義を、拡張可能バリアントでは以下のように表現する。

code: (hs)

type Color = Variant

'[ "rgb" >: (Int, Int, Int)

, "cmyk" >: (Int, Int, Int, Int)

]

拡張可能バリアントは、パターンマッチに拡張可能レコード /recordを用いるため、パターンマッチにおいて強みを引き出すことができる。

パターンマッチ

matchField を使えば簡単に定義できる。

code: (hs)

type Shape = Variant

'[ "circle" >: Circle

, "rect" >: Rect

]

type Point = Record

'[ "x" >: Double

, "y" >: Double

]

type Circle = Record

'[ "mid" >: Point

, "r" >: Double

]

type Rect = Record

'[ "ll" >: Point

, "ur" >: Point

]

area :: Shape -> Double

area = matchField

$ #circle @= (\(Circle s) -> pi * (s ^. #r) ^ 2)

<: #rect @= ((*) <$> width <*> height)

<: nil

code: (hs)

#!/usr/bin/env stack

{- stack repl

--resolver nightly-2018-05-18

--package extensible-0.4.9

--package lens

{-# LANGUAGE DataKinds #-}

{-# LANGUAGE OverloadedLabels #-}

{-# LANGUAGE TypeOperators #-}

import Data.Extensible

import Control.Lens (( # ))

type Color = Variant

'[ "rgb" >: (Int, Int, Int)

, "cmyk" >: (Int, Int, Int, Int)

]

green :: Color

green = #rgb # (0, 255, 0)

white :: Color

white = #cmyk # (0, 0, 0, 0)

main :: IO ()

main = do

print green

print white

実行結果

code: (hs)

*Main> main

EmbedAt $(mkMembership 0) (rgb @= (0,255,0))

EmbedAt $(mkMembership 1) (cmyk @= (0,0,0,0))

多相なパターンマッチの例

ABC 型は AB 型を内包するような型になっているため、shrinkAssoc 関数を使えば、任意のABCのサブセットについて動作するような関数 f を定義することができる。

code: (haskell)

#!/usr/bin/env stack

{- stack repl

--resolver nightly-2018-05-29

--package extensible-0.4.9

--package lens

{-# LANGUAGE DataKinds #-}

{-# LANGUAGE FlexibleContexts #-}

{-# LANGUAGE OverloadedLabels #-}

{-# LANGUAGE TypeOperators #-}

import Data.Extensible

import Control.Lens ((#))

import Data.Char (toUpper)

type ABC = Variant "a" >: String, "b" >: String, "c" >: String

type AB = Variant "a" >: String, "b" >: String

f :: IncludeAssoc "a" >: String, "b" >: String, "c" >: String xs

=> Variant xs -> String

f = matchField $ shrinkAssoc

$ #a @= id

<: #b @= map toUpper

<: #c @= (\c -> mconcat ":", c, ":")

<: nil

abc :: ABC

abc = #c # "c"

ab :: AB

ab = #b # "b"

main :: IO ()

main = do

print abc

print ab

print $ f abc

print $ f ab

実行結果

code:_

*Main> main

EmbedAt $(mkMembership 2) (c @= "c")

EmbedAt $(mkMembership 1) (b @= "b")

":c:"

"B"

Variant 型について

Variant の定義は以下の通りである。

code: (hs)

type Variant = VariantOf Identity

type VariantOf h = (:|) (Field h)

よって、以下の定義と等しい。

code: (hs)

type Variant xs = Field Identity :| xs

値の定義

color1 と color2 はどちらも値は同じだが、型が異なる。

code: (hs)

#!/usr/bin/env stack

{- stack repl

--resolver nightly-2018-05-18

--package extensible-0.4.9

--package lens

{-# LANGUAGE DataKinds #-}

{-# LANGUAGE OverloadedLabels #-}

{-# LANGUAGE TypeOperators #-}

import Data.Extensible

import Control.Lens (( # ))

type Color = Variant

'[ "rgb" >: (Int, Int, Int)

, "cmyk" >: (Int, Int, Int, Int)

]

color1 :: Variant ' "rgb" >: (Int, Int, Int)

color1 = #rgb # (0, 0, 0)

color2 :: Color

color2 = #rgb # (0, 0, 0)

main :: IO ()

main = do

print color1

print color2

実行結果

code: (hs)

*Main> main

EmbedAt $(mkMembership 0) (rgb @= (0,0,0))

embedAssoc

embedAssoc は Field から Variant への変換に利用することができる。

型は以下の通り。

code:_

embedAssoc :: Associate k a xs => h (k :> a) -> h :| xs

ここで、少し具体化して Field から Variant への変換を考えると、h は Field Identity に特殊化されるため、以下のようになる。

code:_

embedAssoc :: Associate k a xs => Field Identity (k :> a) -> Field Identity :| xs

embedAssoc :: Associate k a xs => Field Identity (k :> a) -> Variant xs

しかしながら、フィールドの key を基準として変換を行うため、以下のような定義はコンパイルできない。

code: (hs)

type Color = Variant

'[ "rgb" >: (Int, Int, Int)

, "cmyk" >: (Int, Int, Int, Int)

]

badColor :: Color

badColor = embedAssoc $ #rgb2 @= (0, 0, 0)

なぜなら rgb2 というフィールドは Color 型に存在しないためである。

EmbedAt

EmbedAt構成子を使って値を作ることもできます。keyが重複している場合などで便利かもしれません。

code: (hs)

#!/usr/bin/env stack

{- stack repl

--resolver lts-12.11

--package extensible-0.4.9

--package lens

{-# LANGUAGE DataKinds #-}

{-# LANGUAGE OverloadedLabels #-}

{-# LANGUAGE TypeOperators #-}

{-# LANGUAGE TemplateHaskell #-}

{-# LANGUAGE PolyKinds #-}

import Data.Extensible

import Control.Lens (( # ))

type Args = Variant

'[ "args" >: Int

, "args" >: (Int, Int)

, "args" >: Int

]

arg1 :: Args

arg1 = EmbedAt $(mkMembership 1) (#args @= (2,3))

arg2 :: Args

arg2 = EmbedAt $(mkMembership 0) (#args @= 4)

arg3 :: Args

arg3 = EmbedAt $(mkMembership 2) (#args @= 10)

f :: Args -> Int

f = matchField

$ #args @= id

<: #args @= uncurry (+)

<: #args @= (*100)

<: nil

実行結果

code: (shell)

*Main> f arg1

*Main> f arg2

*Main> f arg3

1000