Tags: Haskell, Variant | November 4, 2018 |
Changelog
- 2018-11-08 (20h30): I’ve added the “Variant + Either” approach in reaction to a reddit discussion
- 2018-11-08 (23h00): added section about the
FlowT
approach
This post is a follow-up to a post Matt Parsons has just published: The Trouble with Typed Errors (discussion on Reddit).
While I totally agree with the diagnostic, I don’t fully agree with the conclusion. in particular:
In PureScript or OCaml, you can use open variant types to do this flawlessly. Haskell doesn’t have open variants, and the attempts to mock them end up quite clumsy to use in practice.
Being the author of an open Variant type (doc) in Haskell, I don’t think they are that clumsy, so let’s compare!
Variant + Either approach
First let’s rewrite the safe functions head
, lookup
and parse
by making them return a Variant
on the Left
side:
{-# LANGUAGE TypeApplications #-}
import Haskus.Utils.Variant
import Prelude hiding (head,lookup)
import qualified Prelude
import Text.Read
data ParseError = ParseError deriving Show
parse :: String -> Either (V '[ParseError]) Integer
parse s = case readMaybe s of
Just i -> Right i
Nothing -> Left (V ParseError)
data HeadError = ListWasEmpty deriving Show
head :: [a] -> Either (V '[HeadError]) a
head [] = Left (V ListWasEmpty)
head (x:_) = Right x
data LookupError k = KeyWasNotPresent k deriving Show
lookup :: Eq k => k -> [(k,v)] -> Either (V '[LookupError k]) v
lookup k vs = case Prelude.lookup k vs of
Just v -> Right v
Nothing -> Left (V (KeyWasNotPresent k))
Now to compose these functions, we just have to write:
import Data.Bifunctor (first)
liftLeft :: LiftVariant xs ys => Either (V xs) r -> Either (V ys) r
liftLeft = first liftVariant
foo str = do
c <- liftLeft $ head str
r <- liftLeft $ lookup c codeMap
liftLeft $ parse (r ++ tail str)
where
codeMap :: [(Char, String)]
codeMap = [ ('x', "0x")
, ('d', "")
]
- We can fix the
Variant
type at the definition site:
foo :: String -> Either (V '[ParseError, LookupError Char, HeadError]) Integer
-- The order of the error types doesn't matter and we can add additional error
-- types if we want:
foo :: String -> Either (V '[Float,Int,Double,ParseError,LookupError Char,HeadError,String]) Integer
Test:
> foo "d10"
Right 10
> foo "x10"
Right 16
> foo "u10"
Left V @(LookupError Char) (KeyWasNotPresent 'u')
> foo ""
Left V @HeadError ListWasEmpty
> foo "d10X"
Left V @ParseError ParseError
- Or if don’t give
foo
a type signature we can fix theVariant
type when we call it:
> foo "d10" :: Either (V '[ParseError,HeadError,LookupError Char]) Integer
Right 10
-- The order of the error types still doesn't matter and we can add additional
-- error types if we want:
> foo "d10" :: Either (V '[Float,Int,Double,ParseError,LookupError Char,HeadError,String]) Integer
Right 10
- Or we can give a generic type signature to
foo
:
foo :: forall es.
('[HeadError,ParseError,LookupError Char] :<< es
) => String -> Either (V es) Integer
It allows us to use TypeApplications
to pass the list of error types:
> foo @'[ParseError,HeadError,LookupError Char] "d10"
Right 10
> foo @'[HeadError,LookupError Char,ParseError] "d10X"
Left V @ParseError ParseError
ExceptT-like approach
Just like ExceptT wraps Either
, we can use a FlowT
newtype to wraps a Variant
. Compared to the approach above (“Either + Variant”), we avoid the Either
indirection: the first value of the Variant is considered as the Right
value and the other ones as the error values.
The example above becomes:
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
import Haskus.Utils.Variant.Flow
import Prelude hiding (head,lookup)
import qualified Prelude
import Text.Read
data ParseError = ParseError deriving Show
parse :: String -> Flow '[ParseError] Integer
parse s = case readMaybe s of
Just i -> pure i
Nothing -> throwE ParseError
data HeadError = ListWasEmpty deriving Show
head :: [a] -> Flow '[HeadError] a
head [] = throwE ListWasEmpty
head (x:_) = pure x
data LookupError k = KeyWasNotPresent k deriving Show
lookup :: Eq k => k -> [(k,v)] -> Flow '[LookupError k] v
lookup k vs = case Prelude.lookup k vs of
Just v -> pure v
Nothing -> throwE (KeyWasNotPresent k)
foo :: String -> Flow '[ParseError, LookupError Char, HeadError] Integer
-- foo :: forall es.
-- ('[HeadError,ParseError,LookupError Char] :<< es
-- ) => String -> Flow es Integer
foo str = do
c <- liftFlowT $ head str
r <- liftFlowT $ lookup c codeMap
liftFlowT $ parse (r ++ tail str)
where
codeMap :: [(Char, String)]
codeMap = [ ('x', "0x")
, ('d', "")
]
Test:
> runFlow (foo "d10")
V @Integer 10
> runFlow (foo "x10")
V @Integer 16
> runFlow (foo "u10")
V @(LookupError Char) (KeyWasNotPresent 'u')
> runFlow (foo "")
V @HeadError ListWasEmpty
> runFlow (foo "d10X")
V @ParseError ParseError
> foo "" `catchE` (\ListWasEmpty -> success 42) :: Flow '[ParseError,LookupError Char] Integer
FlowT (Identity V @Integer 42)
(FlowT
is available from release 2.4 of haskus-utils-variant
package).
Full Variant approach
Finally, there is another approach that directly uses Variant
with RebindableSyntax
extension.
First let’s rewrite the safe functions head
, lookup
and parse
by making them return a Variant
:
{-# LANGUAGE TypeApplications #-}
import Haskus.Utils.Variant
import Prelude hiding (head,lookup)
import qualified Prelude
import Text.Read
data ParseError = ParseError deriving Show
parse :: String -> V '[Integer,ParseError]
parse s = case readMaybe s of
Just i -> V @Integer i -- we use the `V` pattern to index the
Nothing -> V ParseError -- Variant by type
data HeadError = ListWasEmpty deriving Show
head :: [a] -> V '[a,HeadError]
head [] = toVariantAt @1 ListWasEmpty -- we can't index the Variant by
head (x:_) = toVariantAt @0 x -- type because `a` is ambiguous,
-- so we do it by index explicitly
data LookupError k = KeyWasNotPresent k deriving Show
lookup :: Eq k => k -> [(k,v)] -> V '[v,LookupError k]
lookup k vs = case Prelude.lookup k vs of
Just v -> toVariantAt @0 v -- ditto
Nothing -> toVariantAt @1 (KeyWasNotPresent k)
Now we could use Variant
’s primitives to compose these functions (again see the documentation). But instead I will show how we can use them implicitly with do-notation thanks to the RebindableSyntax
extension:
{-# LANGUAGE RebindableSyntax #-}
import Haskus.Utils.Variant.Syntax
import Prelude hiding ((>>=),(>>),return)
foo :: String -> V '[Integer, ParseError, LookupError Char, HeadError]
foo str = do
c <- head str
r <- lookup c codeMap
parse (r ++ tail str)
where
codeMap :: [(Char, String)]
codeMap = [ ('x', "0x")
, ('d', "")
]
Test:
> foo "d10"
V @Integer 10
> foo "x10"
V @Integer 16
> foo "u10"
V @(LookupError Char) (KeyWasNotPresent 'u')
> foo ""
V @HeadError ListWasEmpty
> foo "d10X"
V @ParseError ParseError
Conclusion
It doesn’t look that clumsy to me! ;-)