elmで頑張ってValueObjectを定義したけどやっぱ型クラスないと無理矢理感が否めない

Haskellっぽいでおなじみのelmにはtypeclassがない。これによりMaybe.andThenを使わざるを得ない局面などにぶつかることが多々ある。

これ自体はelmの設計方針だったりするので特に文句を言う筋合いもないので気に入らなければpurescriptやfp-tsでも使えば終わる話だと思うのだけどelmは関数型およびjavascript界隈弱者にとって学習コストがめちゃくちゃ低いというメリットがそれなりの存在感を持っているのでやっぱり使いたい。

で、この度ValueObjectっぽい型を表現しようとして試行錯誤したところ以下のような形が限界だった。

module ValueObject exposing (..)

type ValueObject a = ValueObject a

type ValidateResult a e
    = Ok (ValueObject a)
    | Err e

validate : (a -> ValidateResult a e) -> ValueObject a -> ValidateResult a e
validate func (ValueObject a) = func a

これ結構いびつで、ValueObjectをラップするコンテキストが必要になるので以下のような使用イメージになる。

module ValueObjectSpec exposing (..)

import Test exposing (..)
import Expect
import ValueObject exposing (ValueObject(..), validate, ValidateResult(..))

type PositiveIntItem = PositiveIntItem (ValueObject Int)

positiveIntItem : Int -> PositiveIntItem
positiveIntItem = ValueObject >> PositiveIntItem

unwrapPositiveIntItem : PositiveIntItem -> Int
unwrapPositiveIntItem (PositiveIntItem (ValueObject a)) = a

invalidPositiveIntItemErrorMessage : Int -> String
invalidPositiveIntItemErrorMessage = String.fromInt >> (++) "Value must be positive but: "

validatePositiveIntItem : PositiveIntItem -> ValidateResult Int String
validatePositiveIntItem (PositiveIntItem a) =
    let
        func : Int -> ValidateResult Int String
        func x =
            if x > 0 then ValueObject.Ok a
            else ValueObject.Err (invalidPositiveIntItemErrorMessage x)
    in
    validate func a

type RecordItem = RecordItem (ValueObject { x: Int, y: String })

recordItem : Int -> String -> RecordItem
recordItem x y = RecordItem (ValueObject { x = x, y = y })

unwrapRecordItem : RecordItem -> { x: Int, y: String }
unwrapRecordItem (RecordItem (ValueObject a)) = a

invalidRecordItemXErrorMessage : Int -> String
invalidRecordItemXErrorMessage = String.fromInt >> (++) "property `x` must be positive but: "

invalidRecordItemYErrorMessage : String
invalidRecordItemYErrorMessage = "property `y` must include some char but empty"

invalidRecordItemTotallyErrorMessage : Int -> String
invalidRecordItemTotallyErrorMessage = invalidRecordItemXErrorMessage >> (++) invalidRecordItemYErrorMessage

validateRecordItem : RecordItem -> ValidateResult { x: Int, y: String } String
validateRecordItem (RecordItem a) =
    let
        func : { x: Int, y: String } -> ValidateResult { x: Int, y: String } String
        func r =
            case (r.x < 0, String.length r.y == 0 ) of
                (True, True) -> ValueObject.Err (invalidRecordItemTotallyErrorMessage r.x)
                (False, True) -> ValueObject.Err invalidRecordItemYErrorMessage
                (True, False) -> ValueObject.Err (invalidRecordItemXErrorMessage r.x)
                (False, False) -> ValueObject.Ok a
    in
    validate func a

suite : Test
suite = describe "validate"
    [ test "works against a valid primitive value" <|
        \_ ->
            let
                correctItem = positiveIntItem 7

            in
            Expect.equal (validatePositiveIntItem correctItem) (ValueObject.Ok (ValueObject <| unwrapPositiveIntItem correctItem))
    , test "works against an invalid primitive value" <|
        \_ ->
            let
                incorrectItem = positiveIntItem -1
            in
            Expect.equal (validatePositiveIntItem incorrectItem) (ValueObject.Err (invalidPositiveIntItemErrorMessage <| unwrapPositiveIntItem incorrectItem))
    , test "works against a valid record " <|
        \_ ->
            let
                correctItem = recordItem 1 "a"
            in
            Expect.equal (validateRecordItem correctItem) (ValueObject.Ok (ValueObject <| unwrapRecordItem correctItem))
    , test "works against an invalid record (1)" <|
        \_ ->
            let
                incorrectXItem = recordItem -1 "a"
            in
            Expect.equal (validateRecordItem incorrectXItem) (ValueObject.Err (invalidRecordItemXErrorMessage <| (unwrapRecordItem >> (.x)) incorrectXItem) )
    , test "works against an invalid record (2)" <|
        \_ ->
            let
                incorrectYItem = recordItem 1 ""
            in
            Expect.equal (validateRecordItem incorrectYItem) (ValueObject.Err (invalidRecordItemYErrorMessage))
    , test "works against an invalid record (3)" <|
        \_ ->
            let
                incorrectItem = recordItem -1 ""
            in
            Expect.equal (validateRecordItem incorrectItem) (ValueObject.Err (invalidRecordItemTotallyErrorMessage <| (unwrapRecordItem >> (.x)) incorrectItem))
    ]

このような感じになってしまうしこれ以外にもMonadicになんか扱いたいみたいな場合のアドホック多相を実現する術がなくて冒頭で述べたように困らないでもない。

まあ、elmの思想に合わせて素直に関数のオーバーロードとすれば済む話ではあると思う。

ではどのようなものを求めているかをHaskellで書いてみるとこんな感じになるだろう。

{-# LANGUAGE  MultiParamTypeClasses #-}
module ValueObject where
import Data.Aeson (Value)

data ValueObjectValidationResult a e = Ok a | Err e
    deriving(Show, Eq)

class ValueObject a e where
    validate :: a -> ValueObjectValidationResult a e

newtype Under100PositiveIntItem = Under100PositiveIntItem { getValue :: Int } deriving (Show, Eq)

data Under100PositiveIntItemValidationError = Negative | OverLimit deriving (Show, Eq)

type Under100PositiveIntItemValidationResult = ValueObjectValidationResult Under100PositiveIntItem Under100PositiveIntItemValidationError

instance ValueObject Under100PositiveIntItem Under100PositiveIntItemValidationError where
    validate a
        | v < 0 = Err Negative
        | v > 100 = Err OverLimit
        | otherwise = Ok a
        where
            v = getValue a


under100positiveIntItem :: Int -> Under100PositiveIntItemValidationResult
under100positiveIntItem = validate . Under100PositiveIntItem

main :: IO ()
main = do
    print $ under100positiveIntItem 1 == Ok (Under100PositiveIntItem {getValue= 1})
    print $ under100positiveIntItem (-1) == Err Negative
    print $ under100positiveIntItem 101 == Err OverLimit

これはこれでなんか冗長な感じはあるけど結構堅牢だと思うので型クラスって強力だなって感じ。