Archive

Test Automation

Reference the following guide for installing the unit test package.

Here’s a couple of unit tests:

module HelloTest exposing (..)

import Controls.Login as Login exposing (Model)
import Home exposing (..)
import Test exposing (..)
import Expect


suite : Test
suite =
    describe "Login module"
        [ test "runtime.tryLogin succeeds with valid credentials" <|
            \_ ->
                let
                    ( login, runtime ) =
                        ( Login.Model "test" "test" False, Home.runtime )

                    result =
                        runtime.tryLogin login
                in
                    Expect.equal result.loggedIn True
        , test "runtime.tryLogin fails with invalid credentials" <|
            \_ ->
                let
                    ( login, runtime ) =
                        ( Login.Model "test" "invalid_password" False, Home.runtime )

                    result =
                        runtime.tryLogin login
                in
                    Expect.equal result.loggedIn False
        ]

Appendix

Here’s some of the test dependencies below.

Home.elm

module Home exposing (..)

import Domain.Core exposing (..)
import Controls.Login as Login exposing (..)
import Tests.TestAPI as TestAPI exposing (tryLogin)
import Services.Server as Services exposing (tryLogin)
import Html exposing (..)
import Html.Attributes exposing (..)


main =
    Html.beginnerProgram
        { model = model
        , update = update
        , view = view
        }



-- CONFIGURATION


configuration : Configuration
configuration =
    Isolation


type Configuration
    = Integration
    | Isolation


type alias Dependencies =
    { tryLogin : Loginfunction }


runtime : Dependencies
runtime =
    case configuration of
        Integration ->
            Dependencies Services.tryLogin

        Isolation ->
            Dependencies TestAPI.tryLogin



-- MODEL


type alias Model =
    { videos : List Video
    , articles : List Article
    , login : Login.Model
    }


model : Model
model =
    { videos = [], articles = [], login = Login.model }


init : ( Model, Cmd Msg )
init =
    ( model, Cmd.none )



-- UPDATE


type Msg
    = Video Video
    | Article Article
    | Submitter Submitter
    | Search String
    | Register
    | OnLogin Login.Msg


update : Msg -> Model -> Model
update msg model =
    case msg of
        Video v ->
            model

        Article v ->
            model

        Submitter v ->
            model

        Search v ->
            model

        Register ->
            model

        OnLogin subMsg ->
            case subMsg of
                Login.Attempt v ->
                    let
                        latest =
                            Login.update subMsg model.login
                    in
                        { model | login = runtime.tryLogin latest }

                Login.UserInput _ ->
                    { model | login = Login.update subMsg model.login }

                Login.PasswordInput _ ->
                    { model | login = Login.update subMsg model.login }



-- VIEW


view : Model -> Html Msg
view model =
    div []
        [ header []
            [ label [] [ text "Nikeza" ]
            , model |> sessionUI
            ]
        , footer [ class "copyright" ]
            [ label [] [ text "(c)2017" ]
            , a [ href "" ] [ text "GitHub" ]
            ]
        ]


sessionUI : Model -> Html Msg
sessionUI model =
    let
        loggedIn =
            model.login.loggedIn

        welcome =
            p [] [ text <| "Welcome " ++ model.login.username ++ "!" ]

        signout =
            a [ href "" ] [ label [] [ text "Signout" ] ]
    in
        if (not loggedIn) then
            Html.map OnLogin <| Login.view model.login
        else
            div [ class "signin" ] [ welcome, signout ]

TestAPI.elm

module Tests.TestAPI exposing (..)

import Controls.Login as Login exposing (Model)


tryLogin : Login.Model -> Login.Model
tryLogin credentials =
    let
        successful =
            String.toLower credentials.username == "test" && String.toLower credentials.password == "test"
    in
        if successful then
            { username = credentials.username, password = credentials.password, loggedIn = True }
        else
            { username = credentials.username, password = credentials.password, loggedIn = False }

Core.elm

module Domain.Core exposing (..)

import Controls.Login as Login exposing (Model)

...

type alias Loginfunction =
    Login.Model -> Login.Model


tryLogin : Loginfunction -> String -> String -> Login.Model
tryLogin loginf username password =
    loginf <| Login.Model username password False

Login.elm

module Controls.Login exposing (..)

import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (..)


-- MODEL


type alias Model =
    { username : String
    , password : String
    , loggedIn : Bool
    }


model : Model
model =
    Model "" "" False



-- UPDATE


type Msg
    = UserInput String
    | PasswordInput String
    | Attempt ( String, String )


update : Msg -> Model -> Model
update msg model =
    case msg of
        UserInput v ->
            { model | username = v }

        PasswordInput v ->
            { model | password = v }

        Attempt ( username, password ) ->
            { model | username = username, password = password }



-- VIEW


view : Model -> Html Msg
view model =
    div []
        [ input [ class "signin", type_ "submit", value "Signin", onClick <| Attempt ( model.username, model.password ) ] []
        , input [ class "signin", type_ "password", placeholder "password", onInput PasswordInput, value model.password ] []
        , input [ class "signin", type_ "text", placeholder "username", onInput UserInput, value model.username ] []
        ]

I revisited code for a bank account kata I practiced a couple weeks ago.

Take the following code:

let update account amount operator = account |>  function
           | Checking v -> Checking ( v + (operator * amount) )
           | Savings  v -> Savings  ( v + (operator * amount) )
           | Business v -> Business ( v + (operator * amount) )

The code above may look okay at first glance. However, one would argue that the parentheses are somewhat verbose.

As a result, I attempted to clarify the code by using the backwards pipe operator:

let update account amount operator = account |>  function
           | Checking v -> Checking <| v + (operator * amount)
           | Savings  v -> Savings  <| v + (operator * amount)
           | Business v -> Business <| v + (operator * amount)

The complete code with the “<|" used can be found below:

module BankAccountImpl2

type Account =        
    | Checking of decimal
    | Savings  of decimal
    | Business of decimal

type Commands =
    | Withdraw of Account * decimal
    | Deposit  of Account * decimal
    | Transfer of Account * Account * decimal

type Response =
    | Withdrawal       of State   * State
    | WithdrawalFailed of Account * decimal

    | Deposited        of State   * State             
    | DepositFailed    of Account * decimal

    | Transferred      of TransferSummary   * decimal
    | TransferFailed   of Account * Account * decimal

and State =
    | BeforeDeposit    of Account * decimal
    | AfterDeposit     of Account

    | BeforeWithdrawal of Account * decimal
    | AfterWithdrawal  of Account

and TransferSummary = { 
    FromBalanceBefore: Account ; ToBalanceBefore: Account
    FromBalanceAfter:  Account ; ToBalanceAfter:  Account }

(*Functions*)
let balanceOf = function
                | Checking v
                | Savings  v
                | Business v -> v

let update account amount operator = account |>  function
           | Checking v -> Checking <| v + (operator * amount)
           | Savings  v -> Savings  <| v + (operator * amount)
           | Business v -> Business <| v + (operator * amount)

let debit  account amount =  update account amount <| - 1m
let credit account amount =  update account amount <| + 1m

let canWithdraw account amount = 
    balanceOf account >= amount &&
    amount > 0m

let handleWithdraw = function
    | Withdraw (account , amount) when canWithdraw account amount ->
           Some <| Withdrawal (BeforeWithdrawal (account ,     amount),
                               AfterWithdrawal  (debit account amount))

    | Withdraw (account , amount) when not (canWithdraw account amount) ->
           Some <| WithdrawalFailed (account, amount)
    | _ -> None

let handleDeposit = function
    | Deposit (account , amount) when amount > 0m && amount <= 1000000000m ->
           Some <| Deposited((BeforeDeposit (account , amount),
                              AfterDeposit  (credit account amount) ))

    | Deposit (account , amount) ->
           Some <| DepositFailed (account , amount)

    | _ -> None

let handleTransfer = function
    | Transfer (fromAccount, toAccount, amount) when canWithdraw fromAccount amount ->
           Some <| Transferred ({ FromBalanceBefore=fromAccount
                                  ToBalanceBefore=  toAccount
                                  FromBalanceAfter= debit  fromAccount amount
                                  ToBalanceAfter=   credit toAccount   amount } ,
                                  amount)

    | Transfer (fromAccount, toAccount, amount) when not (canWithdraw fromAccount amount) ->
           Some <| TransferFailed (fromAccount, toAccount, amount)
    | _ -> None

(*Client*)
let deposit =    handleDeposit  <| Deposit  (Checking 100m , -10m)
let withdrawal = handleWithdraw <| Withdraw (Savings  0m   , +10m)
let transfer =   handleTransfer <| Transfer (Checking 100m , Savings 150m , -10m)

(*Tests*)
open FsCheck
open FsCheck.Xunit

type Run100KAttribute() =
    inherit PropertyAttribute(
        MaxTest = 100000,
        QuietOnSuccess = true)

[<Run100K>]
let ``deposits greater than zero AND less than 1 million always succeed`` () =

    // Setup
    let validDeposits = function
        | Deposit (acct , bal) -> bal > 0m && 
                                  bal <= 1000000m
        | _ -> false

    let isDeposited deposit = function
        | Some v -> match v with
                    | Deposited _ -> true
                    | _           -> false
        | _ -> false

    // Test
    Arb.generate<Commands> 
    |> Gen.filter validDeposits
    |> Arb.fromGen
    |> Prop.forAll 
    <| fun deposit -> handleDeposit deposit
                      |> isDeposited