Haskellで文字列っぽい型同士を結合する演算子が欲しい。その3(動作するが改善の余地結構有り)

前回の記事までのあらすじ

Haskellで文字列っぽい型同士を結合する演算子+++が欲しい。左辺、右辺、返り値の関係は下表のようになって欲しい。また、 foo :: String +++ bar :: ByteString のような型注釈は不要なようにしたい

左辺 ＼ 右辺	文字列リテラル	String	Lazy.Text	Text	Lazy.ByteString	ByteString
文字列リテラル	String	String	Lazy.Text	Text	Lazy.ByteString	ByteString
String		String	Lazy.Text	Text	Lazy.ByteString	ByteString
Lazy.Text			Lazy.Text	Text	Lazy.ByteString	ByteString
Text				Text	Lazy.ByteString	ByteString
Lazy.ByteString					Lazy.ByteString	ByteString
ByteString						ByteString

unsafeCoerceを使って実装したが、わりと危ないのでより良い実装方法を探し求めていた

動作するバージョン

• 似たような問題にはまっている人がstackoverflowにいたので、その回答を参考にしました。
• ExtendedDefaultRulesプラグマを使うようにしました。
• ExtendedDefaultRules状態で文字列リテラルをデフォルトでStringに固定するため、StringInferencerという型クラスを間にはさんでいる。

{-# LANGUAGE ExtendedDefaultRules  #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude     #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE UndecidableInstances  #-}

module Data.Strings where

import           Data.Function              (($))
import           Data.Monoid                ((<>))
import           Data.String                (String)
import           System.IO                  (IO, print)

import qualified Data.ByteString            as B
import qualified Data.ByteString.Builder    as BB
import qualified Data.ByteString.Lazy       as LB
import qualified Data.Text                  as T
import qualified Data.Text.Lazy             as LT

class StringInferencer a where
  string :: a -> String

instance StringInferencer String where
  string x = x

class BinaryOperation l r a where
  (+++) :: l -> r -> a

instance {-# INCOHERENT #-} BinaryOperation B.ByteString B.ByteString B.ByteString where
  (+++) l r = l <> r

instance {-# INCOHERENT #-} (StringInferencer l) => BinaryOperation l B.ByteString B.ByteString where
  (+++) l r = LB.toStrict (BB.toLazyByteString $ BB.stringUtf8 $ string l) <> r

instance {-# INCOHERENT #-} (StringInferencer l, StringInferencer r) => BinaryOperation l r String where
  (+++) l r = string l <> string r

-- 以下似たようなものがえんえん続く

動かしてみる

{-# LANGUAGE ExtendedDefaultRules  #-}
main :: IO ()
main = do
  putStrLn $ "Hello, " +++ "World"
  CB.putStrLn $ "Hello, " +++ CB.pack "World"

実行結果

Hello, World
Hello, World

動いた!

ただ、これ利用者はいちいちExtendedDefaultRulesを有効にしなければいけない。有効にしない場合は下記のエラーが出る。

• Ambiguous type variable ‘l0’ arising from the literal ‘"Hello, "’
  prevents the constraint ‘(Data.String.IsString
                              l0)’ from being solved.
  Probable fix: use a type annotation to specify what ‘l0’ should be.
  These potential instances exist:
    instance Data.String.IsString CB.ByteString
      -- Defined in ‘Data.ByteString.Internal’
    instance Data.String.IsString T.Text -- Defined in ‘Data.Text’
    instance Data.String.IsString LT.Text
      -- Defined in ‘Data.Text.Lazy’
    ...plus one other
    ...plus four instances involving out-of-scope types
    (use -fprint-potential-instances to see them all)
• In the first argument of ‘(+++)’, namely ‘"Hello, "’
  In the second argument of ‘($)’, namely ‘"Hello, " +++ "World"’
  In a stmt of a 'do' block: putStrLn $ "Hello, " +++ "World"
...
...
...

cabalファイルに書いておけばストレスはそんなにないが、できれば無しでも動くようにしたい。ソースはこちら https://github.com/saturday06/strings 進展があったら「その4」を投稿します。