この記事は Haskell Advent Calendar 2016 の9日目の記事です。
とか云ってもう11日ですね、ホントすみません。
8日目は @phi16_ さん、10日目は @bra_cat_ket さん でした。
Haskell を書き始めてはや5年、Monad や Applicative は使いこなしているけど、それ以上の抽象化のレパートリーを増やせていないと感じていました。
何となく「型レベルプログラミング」という言葉に興味はありつつも、具体的に何を学べば型レベルプログラミングができるようになるのか分からずにいたのです。
そんなあるとき、コマンドラインパーザーのライブラリを探している中でこんな記事を見つけました。
qiita.com
タイトルに「宣言的な型レベルコマンドラインパーザー」とあります。このライブラリが内部で何をしているのか追っていけば型レベルプログラミングってやつが分かるようになるのでは…? そんな思いでこのライブラリのコードを読んでいくことに決めました。
今回はこの optparse-declarative のコードリーディングから得た学びを書き留めます。
型レベルプログラミングの世界に一歩踏み込みたい、型レベルFizzBuzzもいいけどもっと実用的な例を知りたいと思ってる人の参考になれば幸いです。
optparse-declarative とは
田中英行(@tanakh)氏が作ったコマンドラインパーザーです。
CLIツールのために、コマンドライン引数・コマンドラインオプションの取得、サブコマンドの制御などの機能を提供しています。
tanakh 氏自身がとても分かりやすい記事を書かれています。
ただ使うだけであれば、これらの記事を読むだけで充分に感触が掴めると思います。
使い方
公式のサンプルコードをそのまま引用します。
{-# LANGUAGE DataKinds #-}
import Options.Declarative
import Control.Monad.Trans
greet :: Flag "g" '["greet"] "STRING" "greeting message" (Def "Hello" String)
-> Arg "NAME" String
-> Cmd "Greeting command" ()
greet msg name =
liftIO $ putStrLn $ get msg ++ ", " ++ get name ++ "!"
main :: IO ()
main = run_ greet
コマンドライン引数から「挨拶の言葉」と「名前」を受け取って挨拶を出力するコマンドです。
「挨拶の言葉」はデフォルト値が与えられたフラグとして定義されているのでオプションになります。
たったのこれだけで、
- コマンドラインオプションを解析して必要としている型に変換
- コマンドのヘルプ文字列を生成
- 不正なオプションが渡された場合にはエラーを表示
- サブコマンド実装のサポート
などを面倒見てくれます。
--help
オプションとともに呼び出せば、
$ greet --help
Usage: greet [OPTION...] NAME
Greeting command
Options:
-g STRING --greet=STRING greeting message
-? --help display this help and exit
-v[n] --verbose[=n] set verbosity level
このようにいい感じに生成されたヘルプ文字列を表示してくれますし、
不正な引数を与えれば勝手にチェックしてエラーメッセージを表示してくれたりと、全体的にとても楽チンです。
引数の説明や引数名を 型注釈の方 に記述するコーディングスタイルが特徴です。
逆に greet
関数の本体では渡された引数を使うだけで済みます。
optparse-declarative を題材に選んだ理由
このライブラリは 実質1つのファイルだけ で構成されていて、 メインのコードは360行ほど しかありません。
内部で定義されている主要なデータ型は4個, 型クラスは3個ほどだけです。
このボリュームだったら初心者であっても心が折れずに読み進められそうだと思いました。
しかも、とても実用的で具体的な目的のために書かれたものなので、動かしながら理解するのに良さそうだと感じたのです。
実にありがたいことに、きれいで丁寧なコメントも付けられています。
読み解く
では、さっそく読んでいきましょう。
メインのファイルはこれです。
github.com
言語拡張
冒頭にはプラグマの指定が書かれていて、多くの言語拡張が有効化されています。
DataKinds
, PolyKinds
, KindSignatures
, GADTs
, DefaultSignatures
, ExistentialQuantification
, FlexibleContexts
, FlexibleInstances
, GeneralizedNewtypeDeriving
, RankNTypes
, ScopedTypeVariables
, TypeFamilies
, TypeOperators
, MultiWayIf
, TupleSections
以上15個です。
これらの言語拡張は文法に影響を与えるので、最初に意味を確認しておくのがよさそうです。
DataKinds
値コンストラクタを型に、型をカインドに昇格させられる拡張です。
optparse-declarative ではコマンドの型の中に登場していました。
greet :: Flag "g" '["greet"] "STRING" "greeting message" (Def "Hello" String)
-> Arg "NAME" String
-> Cmd "Simple greeting example" ()
型注釈の中に現れる "g"
などの文字列リテラルっぽいものが 型レベル文字列 で、Symbol
というカインドを持っています。
Int
や Bool
のように "g"
自体が型として扱われています。
興味深いのは、この "g" :: Symbol
という型がのちほど "g" :: String
という値として使われることです。
型から値への変換をどういう仕組みで実現しているのか気になります。
KindSignatures
型変数に対してカインド注釈が付けられるようになります。
optparse-declarative の中では Arg
型の定義が、
newtype Arg (placeholder :: Symbol) a = Arg { getArg :: a }
というようになっています。
placeholder :: Symbol
の部分を見ると、型変数 placeholder
のカインドが Symbol
であることが分かります。
GADTs
多相のデータ型を定義する際の新しい文法を導入します。
Maybe a
と同じ意味のデータ型 MyMaybe a
を定義する場合、
data MyMaybe a = MyNothing | MyJust a
と書くところを、
data MyMaybe a where
MyNothing :: MyMaybe a
MyJust :: a -> MyMaybe a
というように書けるようになります。
特定の値コンストラクタにだけ型制約を導入したりといった柔軟なデータ型を作れるようになります。
この拡張は文法に与える変化がとても大きく、事前に知っていないとコードを読み進めるのが無理になると感じました。
DefaultSignatures
型クラスのメソッドを定義する際、デフォルトのメソッド定義にだけ特別な型を与えられるようになります。
class ArgRead a where
unwrap :: a -> Unwrap a
default unwrap :: a ~ Unwrap a => a -> Unwrap a
unwrap = id
default
キーワードが新たに導入されます。
メソッドに複数の型が与えられているように見えるので、知らずにコードを読むと戸惑うことになりますね。
FlexibleInstances
こんな感じのインスタンス宣言が書けるようになります。
class Foo a where
foo :: a -> a
instance Foo String where
foo = id
上記のコードは通常ならば以下のようにコンパイルエラーになります。
error:
? Illegal instance declaration for 'Foo String'
(All instance types must be of the form (T t1 ... tn)
where T is not a synonym.
Use TypeSynonymInstances if you want to disable this.)
? In the instance declaration for 'Foo String'
意訳するとインスタンス化する型は T t1 ... tn
の形をしていないといけないよ。t1
などは具体型ではなく型変数で書かないといけないよ。とのことです。
String
は [] Char
のシノニムなので、確かにこのルールに即していないことが分かります。
FlexibleInstances
拡張を有効にすれば上記のルールに即さない型についてもインスタンス宣言が書けます。
GeneralizedNewtypeDeriving
newtype
キーワードで定義したデータ型をお手軽に各型クラスのインスタンスにしてくれる便利な拡張です。
newtype Foo a = MkFoo [a]
deriving (Functor)
これだけで Foo
型は Functor になります。
愚直にインスタンス化しようとすると次のようになるはずですが、
instance Functor (Foo a) where
fmap f (MkFoo xs) = MkFoo $ fmap f xs
これは fmap
を適用する前に MkFoo
を剥がしたり包んだりしているだけなので、本質的には [a]
に対するインスタンス宣言とやっていることは変わりません。
GeneralizedNewtypeDeriving
拡張はこのような定型のインスタンス宣言を自動化してボイラープレートコードを削減してくれます。
ScopedTypeVariables
型変数にもスコープの概念を持ち込むための拡張です。
instance (KnownSymbol s, KnownSymbols ss) => KnownSymbols (s ': ss) where
symbolVals _ = symbolVal (Proxy :: Proxy s) : symbolVals (Proxy :: Proxy ss)
1行目で型制約を示すために使われている s
という型変数が2行目でも Proxy s
という形で使われています。
通常のルールでは1行目の s
と2行目の s
は偶然同じ名前が宛てられただけの全く別物の型変数とみなされます。ScopedTypeVariables
拡張を有効にすれば、where
以下の文脈でも型変数 s
は KnownSymbol s
という型制約を帯びて解釈されます。
TypeFamilies
型を返す関数を定義できるようになります。
class Option a where
type Value a :: *
get :: a -> Value a
type
キーワードが新たに導入されていますね。
ここでの Value a
は、Value a
型ではなく Value :: * -> *
という型関数によって導き出される何かしらの具体型になると読まなければいけません。
コードの中でいろいろな型を Option
クラスのインスタンスにしていますが、インスタンスにする型によって get
が返す型をいろいろに変えるために型関数を持ち出しているようです。
コードを追う
言語拡張の予習が終わったところで本題のコードを読んでいきます。
サンプルコードにも出てきている run_
関数あたりから。
run_
run_ :: IsCmd c => c -> IO ()
run_ cmd = do
progName <- getProgName
run progName Nothing cmd
run_
関数は do構文の中で getProgName :: IO String
を評価して実行ファイル名を取得しています。
それをそのまま run
関数に渡していますね。
run
run :: IsCmd c => String -> Maybe String -> c -> IO ()
run progName progVer cmd =
run' cmd [progName] progVer =<< getArgs
run
関数は getArgs :: IO [String]
からコマンドライン引数を取得して、今度は run'
関数に渡しています。
run'
run' :: IsCmd c => c -> [String] -> Maybe String -> [String] -> IO ()
run' cmd name mbver args = do
let optDescr =
getOptDescr cmd
++ [ Option "?" ["help"] (NoArg ("help", "t")) "display this help and exit" ]
++ [ Option "V" ["version"] (NoArg ("version", "t")) "output version information and exit"
| isJust mbver ]
++ [ Option "v" ["verbose"] (OptArg (\arg -> ("verbose", fromMaybe "" arg)) "n") "set verbosity level" ]
prog = unwords name
vermsg = prog ++ maybe "" (" version " ++) mbver
header = "Usage: " ++ prog ++ " [OPTION...]" ++ getUsageHeader cmd prog ++ "\n" ++
" " ++ getCmdHelp cmd ++ "\n\n" ++
"Options:"
usage =
usageInfo header optDescr ++
getUsageFooter cmd prog
case getOpt' RequireOrder optDescr args of
(options, nonOptions, unrecognized, errors)
| not $ null errors ->
errorExit name $ intercalate ", " errors
| isJust (lookup "help" options) -> do
putStr usage
exitSuccess
| isJust (lookup "version" options) -> do
putStrLn vermsg
exitSuccess
| otherwise ->
runCmd cmd name mbver options nonOptions unrecognized
run'
関数は let
式で書かれている前半と、 case
式で書かれている後半に分けられます。
前半部分では「オプションの説明」や「バージョン情報」などコマンドのヘルプを表示する際に必要になるヘルプ文字列を組み立てているようです。
前半の見どころは getOptDescr cmd
, getUsageHeader cmd prog
, getUsageFooter cmd prog
, getCmdHelp cmd
あたりですね。
これらは全て型に持たせた情報を取り出してヘルプのための文字列を組み立てています。
後半部分ではコマンドライン引数を解析して、その後の動作を振り分けています。
エラーを表示して終わるか、コマンドのヘルプを表示するか、バージョン情報を表示するか、さもなくばコマンドの実行をしています。
後半の見どころは間違いなく最終行の runCmd cmd name mbver options nonOptions unrecognized
でしょう。
run'
前半部
順番に見ていきます。
getCmdHelp
getCmdHelp
関数は IsCmd
クラスのメソッドとして定義されています。
Cmd
から String
を取り出します。
class IsCmd c where
getCmdHelp :: c -> String
default getCmdHelp :: (c ~ (a -> b), IsCmd b) => c -> String
getCmdHelp f = getCmdHelp $ f undefined
具体的な動作を追うにはインスタンス宣言のほうを見ていく必要がありますね。
IsCmd
クラスのインスタンスになっているのは Flag shortNames longNames placeholder help a -> c
, Arg placeholder String -> c
, Arg placeholder [String] -> c
そして Cmd help ()
です。
その中でも Cmd help ()
に対してのインスタンス宣言を見てみましょう。
instance KnownSymbol help => IsCmd (Cmd help ()) where
getCmdHelp _ = symbolVal (Proxy :: Proxy help)
型レベル文字列から通常の文字列を取り出す方法が分かってきました。
symbolVal :: KnownSymbol n => proxy n -> String
を使うようです。symbolVal
は GHC.TypeLits モジュール で定義されています。
Proxy "foo"
型の値 Proxy
から String
型の値 "foo"
を取り出すことができる不思議な関数です。
Proxy :: Proxy a
は Data.Proxy モジュール で定義されていて型情報だけを持つ値(型に関係しない値)を扱うことができます。
型レベル文字列から Proxy
を作って、Proxy
から文字列を取り出す最小コードはたぶんこんな感じ。
{-# LANGUAGE DataKinds #-}
import Data.Proxy
import GHC.TypeLits
main :: IO ()
main = do
let fooProxy = Proxy :: Proxy "foo"
putStrLn $ symbolVal fooProxy
そして、今回のように独自の型に型レベル文字列を埋め込んで、後程取り出す最小のコードがこちら。
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
import Data.Proxy
import GHC.TypeLits
class GetMessage a where
getMessage :: a -> String
data Foo message = Foo
instance KnownSymbol message => GetMessage (Foo message) where
getMessage _ = symbolVal (Proxy :: Proxy message)
main = do
let foo1 = undefined :: Foo "Hello,world!"
putStrLn $ getMessage foo1
let foo2 = undefined :: Foo "Hello,types!"
putStrLn $ getMessage foo2
インスタンス宣言の中で 型変数のパターンマッチ をしているように見えます。これができるのは ScopedTypeVariables
拡張のおかげです。
また、getMessage
は型から取り出した情報だけを使っているので、型さえ合えば undefined
を突っ込んでも正常に動きます。不思議ー。
getOptDescr
, getUsageHeader
, getUsageFooter
型レベル文字列から通常の文字列を取り出す方法が分かってしまえば、残りの関数も似たことをしているんだなーと分かります。
どれも IsCmd
クラスのメソッドとして定義されていて、
class IsCmd c where
getOptDescr :: c -> [OptDescr (String, String)]
default getOptDescr :: (c ~ (a -> b), IsCmd b) => c -> [OptDescr (String, String)]
getOptDescr f = getOptDescr $ f undefined
getUsageHeader :: c -> String -> String
default getUsageHeader :: (c ~ (a -> b), IsCmd b) => c -> String -> String
getUsageHeader f = getUsageHeader $ f undefined
getUsageFooter :: c -> String -> String
default getUsageFooter :: (c ~ (a -> b), IsCmd b) => c -> String -> String
getUsageFooter f = getUsageFooter $ f undefined
例えば Flag shortNames longNames placeholder help a -> c
型のインスタンス宣言中で書かれれている getOptDescr
の詳細はこんな感じ。
instance ( KnownSymbol shortNames
, KnownSymbols longNames
, KnownSymbol placeholder
, KnownSymbol help
, ArgRead a
, IsCmd c )
=> IsCmd (Flag shortNames longNames placeholder help a -> c) where
getOptDescr f =
let flagname = head $
symbolVals (Proxy :: Proxy longNames) ++
[ [c] | c <- symbolVal (Proxy :: Proxy shortNames) ]
in Option
(symbolVal (Proxy :: Proxy shortNames))
(symbolVals (Proxy :: Proxy longNames))
(if needArg (Proxy :: Proxy a)
then ReqArg
(flagname, )
(symbolVal (Proxy :: Proxy placeholder))
else NoArg
(flagname, "t"))
(symbolVal (Proxy :: Proxy help))
: getOptDescr (f undefined)
型レベルで埋め込んだ情報を取り出しているのが分かりますよね。
run'
後半部
後半部分では実際のコマンド関数に引数を渡して実行している runCmd
が大事そうなのでした。
runCmd
もまた様々な型に対して柔軟に適用できるように IsCmd
クラスのメソッドとして宣言されています。
runCmd
class IsCmd c where
runCmd :: c
-> [String]
-> Maybe String
-> [(String, String)]
-> [String]
-> [String]
-> IO ()
デフォルト実装は無し、インスタンス宣言の方を追っていきましょう。
instance ( KnownSymbol shortNames
, KnownSymbols longNames
, KnownSymbol placeholder
, KnownSymbol help
, ArgRead a
, IsCmd c )
=> IsCmd (Flag shortNames longNames placeholder help a -> c) where
runCmd f name mbver options nonOptions unrecognized =
let flagname = head $
symbolVals (Proxy :: Proxy longNames) ++
[ [c] | c <- symbolVal (Proxy :: Proxy shortNames) ]
mbs = lookup flagname options
in case (argRead mbs, mbs) of
(Nothing, Nothing) ->
errorExit name $ "flag must be specified: --" ++ flagname
(Nothing, Just s) ->
errorExit name $ "bad argument: --" ++ flagname ++ "=" ++ s
(Just arg, _) ->
runCmd (f $ Flag arg) name mbver options nonOptions unrecognized
Flag shortNames longNames placeholder help a -> c
型の値に対して runCmd
を適用したときは、その Flag
が表現している名前付き引数がコマンドラインから与えられるのかを調べていますね。
名前付き引数が与えられていないとき(mbs
が Nothing
)と、名前付き引数が与えられているとき(mbs
が Just s
)とで分岐すると同時に、与えられた引数が目的とする型の値として読めるかどうかを argRead
でチェックしています。
argRead
は ArgRead
クラスのメソッドとして宣言されていて、デフォルト実装としては Text.Read モジュールの readMaybe
を適用するものになっています。
デフォルト実装を上書きして独自実装で目的の型に変換してあげることも可能そうです。
instance ( KnownSymbol placeholder, IsCmd c )
=> IsCmd (Arg placeholder String -> c) where
runCmd f name mbver options nonOptions unrecognized =
case nonOptions of
[] -> errorExit name "not enough arguments"
(opt: rest) ->
case argRead (Just opt) of
Nothing ->
errorExit name $ "bad argument: " ++ opt
Just arg ->
runCmd (f $ Arg arg) name mbver options rest unrecognized
Arg placeholder String -> c
型の値に対して runCmd
を適用したときは、名前無しの引数から最初の1つを消費して先ほどと同じように目的とする型の値に読み替えられるかを argRead
でチェックしていますね。
消費されなかった名前無し引数は再び runCmd
に渡されて再帰的に処理されています。
どうやら runCmd
が呼ばれる度に、コマンド実行のために必要な 名前付き引数 と 名前無し引数 が与えられているか、与えられていてかつ目的とする型に合うかどうかをチェックし、加工しながら再帰しているようです。
instance KnownSymbol help => IsCmd (Cmd help ()) where
runCmd (Cmd m) name _ options nonOptions unrecognized =
case (options, nonOptions, unrecognized) of
(_, [], []) -> do
let verbosityLevel = fromMaybe 0 $ do
s <- lookup "verbose" options
if | null s -> return 1
| all (== 'v') s -> return $ length s + 1
| otherwise -> readMaybe s
runReaderT m verbosityLevel
_ -> do
forM_ nonOptions $ \o ->
errorExit name $ "unrecognized argument '" ++ o ++ "'"
forM_ unrecognized $ \o ->
errorExit name $ "unrecognized option '" ++ o ++ "'"
exitFailure
そしていよいよ Cmd help ()
型の値に対して runCmd
を適用したときです。
前段までの引数のチェックと加工でコマンドラインから渡された引数が消費され尽くしたのかをチェックしているようです。
引数が消費され尽くされていれば最後に Verbosity Level を読んでからコマンドを実行。まだ引数が残っていればその旨をエラー通知しています。
コマンドライン引数から実際の値を取り出す get
関数
optparse-declarative はコマンドで必要としている値を、型に情報を付加することで表現しているんでした。
その関係で、コマンド本体の関数に渡される引数やオプションは Arg _a a
や Flag _a _b _c _d a
といった型をしています。
これらの型の値から実際に使う値を取り出すために get
という関数が用意してあります。
最初にも引用したサンプルコードをもう一度引っ張ってくると、
greet :: Flag "g" '["greet"] "STRING" "greeting message" (Def "Hello" String)
-> Arg "NAME" String
-> Cmd "Greeting command" ()
greet msg name =
liftIO $ putStrLn $ get msg ++ ", " ++ get name ++ "!"
name
といった値を使うときに get name
としているのがそれですね。
get
もまた様々な型に適用でき、様々な型を返す不思議な関数です。
Option
クラスのメソッドとして宣言されています。
class Option a where
type Value a :: *
get :: a -> Value a
ここで type
キーワードが登場しています。
このキーワードによって Value a
が Value a
という型では無く、Value
という型関数に a
という型引数を適用したものだということを表現しているようです。
型を返す関数を定義出来るのは TypeFamilies
拡張のおかげでしたね。
Value a
は例えば Int
や Maybe String
といった具体型になります。
なので get
の型も get :: Flag _a _b _c _d Int -> Int
や Arg _a String -> String
という形になり、あたかも様々な型を返す関数であるように見えます。
Value a
の具体的な実装はどうなっているんでしょうか。
instance Option (Arg _a a) where
type Value (Arg _a a) = a
get = getArg
なるほど、型関数を定義する際には型変数に対してパターンマッチが使えています。
独自の拡張をやってみる
せっかくコードを読み解いて勉強してきたので、optparse-declarative に独自の拡張を追加してみたいと思います。
コマンドオプションとしてリストが受け取れるってのはどうでしょう。
例えば -g オプションに Hello,Hi,Ho
のようにカンマ区切りの文字列が渡された場合、内部でリストに変換され、出力は、
$ greet -g Hello,Hi,Ho world
Hello, world!
Hi, world!
Ho, world!
のようになる想定です。
再び optparse-declarative を辿りながら考えたのですが、どうやら [String]
を ArgRead
クラスのインスタンスにしてあげさえすれば上記目的は達成されるようですね。
与えられた文字列を ,
で分割して文字列のリストにしてあげるだけなので実装はこんな感じ。
{-# LANGUAGE FlexibleInstances #-}
import Data.List.Split
instance ArgRead [String] where
argRead s = splitOn "," <$> s
たったのこれだけです。
コード全体はこんな感じになりました。
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
import Control.Monad
import Control.Monad.Trans
import Data.List.Split
import Options.Declarative
instance ArgRead [String] where
argRead s = splitOn "," <$> s
greet :: Flag "g" '["greet"] "STRING" "greeting message" (Def "Hello" [String])
-> Arg "NAME" String
-> Cmd "Greeting command" ()
greet msgs name =
liftIO $ mapM_ (putStrLn . \msg -> msg ++ ", " ++ get name ++ "!") $ get msgs
main :: IO ()
main = run_ greet
実行します。
$ greet -g Hello,Hi,Ho world
Hello, world!
Hi, world!
Ho, world!
なるほど。
感想
1週間ほどかけて optparse-declarative を読んできました。
中でも TypeFamilies
拡張を有効にした型関数定義と型変数に対するパターンマッチは、型を操作する方法として勉強になりました。
型レベル文字列の扱いについて学べたのも良かったですね。
GADTs
拡張で導入される data
宣言の形にも目が慣れてきた気がします。
optparse-declarative は簡素でコンパクトで、読んでいじって学ぶにはオススメです。Haskell 初心者から中級者への足がかりとして読んでみてはいかがでしょうか。
私からは以上です。