canopy gherkin

gistfile1.fs

module gherkin
open System.Text.RegularExpressions
open System.Linq

type Mode = Given | When | Then

type gwt () = class
    let mutable mode = Given    
    let mutable givens : (unit -> unit) list = []
    let mutable whens : (unit -> unit) list = []
    let mutable thens : (unit -> unit) list = []
    
    member x.Mode
        with get() = mode
        and set(value) = mode <- value
    member x.Givens
        with get() = givens
        and set(value) = givens <- givens @ [value]
    member x.Whens
        with get() = whens
        and set(value) = whens <- whens @ [value]
    member x.Thens
        with get() = thens
        and set(value) = thens <- thens @ [value]
end

let mutable fs : (string * (string list -> unit)) list = []

let private find text = 
    try        
        let potentialMatches = 
            fs 
            |> List.map (fun (t, f) -> (Regex.Matches(text, t).Cast<Match>() 
            |> List.ofSeq, f))
        let ms = 
            potentialMatches 
            |> List.sortBy (fun match' -> (fst match').Count() ) 
            |> List.rev 
            |> List.head
        let bestMatch, f = 
            ((fst ms) 
            |> List.sortBy (fun m -> m.Groups.Count) 
            |> List.rev
            |> List.head, (snd ms))
                    
        if bestMatch.Groups.Count > 1 then
            let args = [1 .. bestMatch.Groups.Count - 1] |> List.map(fun i -> bestMatch.Groups.Item(i).Value)
            (fun () -> f args)
        else
            (fun () -> f [bestMatch.Groups.Item(0).Value])
    with _ -> failwith ("cant find: " + text)

let Register text f =
    fs <- fs @ [(text, f)]

let Given text =
    let gwt = new gwt()
    gwt.Givens <- find text
    gwt

let When text (gwt : gwt) =
    gwt.Whens <- find text
    gwt.Mode <- When
    gwt

let Then text (gwt : gwt) =
    gwt.Thens <- find text
    gwt.Mode <- Then
    gwt

let And text (gwt : gwt) =
    match gwt.Mode with
    | Given -> gwt.Givens <- find text
    | When -> gwt.Whens <- find text
    | Then -> gwt.Thens <- find text
    gwt

let Execute (gwt: gwt) =
    gwt.Givens |> List.iter (fun f -> f())
    gwt.Whens |> List.iter (fun f -> f())
    gwt.Thens |> List.iter (fun f -> f())

----------------------------------

module login
open gherkin
open canopy

Register "that a user is on the '(.*)' page" (fun args ->
    match args.Head with
    | "Login" -> 
        url "http://localhost:49299/"   

    | "Create Faq" -> 
        url "http://localhost:49299/Faq/Create"

    | _ -> ()   

)

Register "base given" (fun args -> System.Console.WriteLine("base given called"))
Register "and given" (fun ags -> System.Console.WriteLine("and given called"))
Register "base when" (fun args -> System.Console.WriteLine("base when called"))
Register "and when" (fun args -> System.Console.WriteLine("and when called"))
Register "base then" (fun args -> System.Console.WriteLine("base then called"))
Register "and then" (fun args -> System.Console.WriteLine("and then called"))
Register "'(.*)' wins" (fun args -> System.Console.WriteLine("{0} called", args.Head))
Register "`(.*)` wins" (fun args -> System.Console.WriteLine("{0} called", args.Head))
Register "`(.*)` and `(.*)` loses" (fun args -> System.Console.WriteLine("{0} and {1} loses called", args.[0], args.[1]))

    
-----------------------------------------

module login_tests

open canopy
open gherkin
open runner

let loginButton = "input[type='submit']"
let email = "#email"
let password = "#password"

let login username password =
    email << username
    password << password
    click loginButton

let Tests () =
    test(fun _ ->
        Given "base given" |>
        And "and given" |>
        And "and given" |>
        When "base when" |>
        And "and when" |>
        And "and when" |>
        Then "base then" |>
        And "and then" |>
        And "and then" |>
        And "'jordan' wins" |>
        And "`chris` wins" |>
        And "`bob` and `sue` loses" |>
        Execute
    )

    test(fun _ ->
        Given "that a user is on the 'Login' page" |>
        And "there is a user registered with email 'name@company.com'" |>
        When "the user supplies an 'email' of 'name@company.com'" |>
        And "clicks the 'Submit' button" |>
        Then "the should be on the 'Login' page" |>
        And "an error message should be displayed" |>
        Execute
    )