Testing Pure Code

How would you test this?

makeUsPhoneNumber ::
    T.Text -- ^ the raw phone number
    -> Maybe UsPhoneNumber
makeUsPhoneNumber num
    | isJust $ T.find isLetter num = Nothing
    | otherwise =
        case chopToLength $ toDigits num of
            num' | properNumber num' -> Just $ UsPhoneNumber num'
            _ -> Nothing
        where
            toDigits = T.filter isDigit
            chopToLength = T.reverse . T.take 10 . T.reverse
            properNumber = (==) 10 . T.length

                            

Testing Pure Code

Positive & Negative test cases?

    | isJust $ T.find isLetter num = Nothing
                        

Obviously can' have letters, so "123456a890" should fail

Testing Pure Code

Using Tasty and HUnit

    testCase "Rejects inputs with letters" $ let
        l1 = "123456a890"
        l2 = "ABC123defa"
        l3 = "this is a full sentence"
        res = makeUsPhoneNumber <$> [l1, l2, l3]
        in all isNothing res @?= True
                        

Testing Pure Code

Property Testing via Quickcheck

testProperty "len (a<>b) == len(a)+len(b)" $ prop
    where
        prop :: ([a], [a]) -> Property
        prop a b = (len a + len b) == len (a <> b)
                        

Hard to Test

foo :: Baz -> ExceptT ErrorType IO
foo baz = do
    now <- liftIO getCurrentTime
    hmm <- liftIO $ getHmm baz
    computeSomething now hmm
    where
        computeSomething now hmm = do
            let res = doFoo now hmm
            when (badState res) $ throwError Boom
            pure res

                        

• Run repeatably
• How to check for error states
• Check that side effects are correct

Easier to Test

runFoo baz = (`runReaderT` foo) =<< makeConf baz
doFoo ts hmm = ...

foo :: Monad m => ReaderT FooConf (ExceptT ErrorType m)
foo = do
    (FooConf now hmm) <- ask
    let res = doFoo now hmm
    when (badState res) $ throwError Boom
    pure res
                        

• No longer cares about the outside world
• Config passed in
• Pure work factored out

Mocking via TypeClasses

class Monad m => MonadTime m where
    now :: m UTCTime

foo :: (MonadTime m,
        MonadReader FooConf m,
        MonadError ErrorType m) => ...
                        

Typeclasses abstract away the concrete monad and let us provide multiple implementations. Hooray ad-hoc polymorphism.

Example from our code

type TestM = ExceptT WrappedProxyError Identity

instance {-# OVERLAPPING #-} GourdOp TestM where
runGourdReq GET "api/profiles/foo/channels" NoRequestData =
    pure . unsafeCast $ UserChannels (Email "baz@mailinator.com") [Phone "1234567890",ProxyPhone "0987654321"]
runGourdReq GET "api/profiles/bar/channels" NoRequestData =
    pure . unsafeCast $ UserChannels (Phone "1234567890") [Email "baz@mailinator.com", ProxyPhone "0987654321"]
                        

type GourdClientM m e r = (MonadIO m, MonadError e m,
    AsHttpError e, AsMissingInterfaceException e,
    MonadReader r m, HasHttpCfg r, HasApiaryClientCfg r,
    HasGourdClientCfg r)

instance {-# OVERLAPPABLE #-} (Monad m, GourdClientM m e r) =>
    GourdOp m where
    runGourdReq = runGourdReqImpl
    runGourdReqOnBehalfOf = runGourdReqOnBehalfOfImpl