F# Designing with Types

Domain Model

namespace Zoo

open System
open System.Web
open System.Web.Http
open System.Web.Http.Tracing
open System.Net.Http
open System.Net
open System.Data.SQLite
open System.Configuration

[<CLIMutable>]
type ObservationGetResponse = { Message : string }

[<CLIMutable>]
type ObservationPostRequest = { Elephant : string; Status : string; Location : string; Activities : string list }

module Location =
    type _T = 
        | NorthMeadow
        | EncounterHabitat
        | SouthHabitat
        | ForestHall
        | ElephantPool
    let value = function
        | NorthMeadow -> "northmeadow"
        | EncounterHabitat -> "encounterhabitat"
        | SouthHabitat -> "southhabitat"
        | ForestHall -> "foresthall"
        | ElephantPool -> "elephantpool"
    let Create (s:string) =
        if s = null then Choice2Of2 ["Location name cannot be NULL"]
        else if s = "" then Choice2Of2 ["Location name cannot be empty"]
        else
            match s.ToLower() with
            | "northmeadow" -> Choice1Of2 NorthMeadow
            | "encounterhabitat" -> Choice1Of2 EncounterHabitat
            | "southHabitat" -> Choice1Of2 SouthHabitat
            | "foresthall" -> Choice1Of2 ForestHall
            | "elephantpool" -> Choice1Of2 ElephantPool
            | _ -> Choice2Of2 [String.Format("{0} is not a valid location name", s)]

module Elephant =
    type _T =
        | Chendra
        | Lily
        | Packy
        | ``Rose-Tu``
        | Samudra
        | ``Sung-Surin``
        | Tusko
    let value = function
        | Chendra -> "chendra"
        | Lily -> "lily"
        | Packy -> "Packy"
        | ``Rose-Tu`` -> "rese-tu"
        | Samudra -> "samudra"
        | ``Sung-Surin`` -> "sung-surin"
        | Tusko -> "tusko"
    let Create (s:string) =
        if s = null then Choice2Of2 ["Elephant name cannot be NULL"]
        else if s = "" then Choice2Of2 ["Elephant name cannot be empty"]
        else
            match s.ToLower() with
            | "chendra" -> Choice1Of2 Chendra
            | "lily" -> Choice1Of2 Lily
            | "packy" -> Choice1Of2 Packy
            | "rose-tu" -> Choice1Of2 ``Rose-Tu``
            | "samudra" -> Choice1Of2 Samudra
            | "sung-surin" -> Choice1Of2 ``Sung-Surin``
            | "tusko" -> Choice1Of2 Tusko
            | _ -> Choice2Of2 [String.Format("{0} is not a valid elephany name", s)]

module Status =
    type _T =
        | Alone
        | ``With Herdmates``
    let value = function
        | Alone -> "alone"
        | ``With Herdmates`` -> "with herdmates"
    let Create (s:string) = 
        if s = null then Choice2Of2 ["Status cannot be NULL"]
        else if s = "" then Choice2Of2 ["Status cannot be empty"]
        else
            match s.ToLower() with
            | "alone" -> Choice1Of2 Alone
            | "with herdmates" -> Choice1Of2 ``With Herdmates``
            | _ -> Choice2Of2 [String.Format("{0} is not a valid status", s)]

module Behavior =
    type _T =
        | Eating
        | Drinking
        | Walking
        | Standing
        | Exploring
        | Playing
        | ``Doing Something``
        | Socializing
    let value = function
        | Eating -> "eating"
        | Drinking -> "drinking"
        | Walking -> "walking"
        | Standing -> "standing"
        | Exploring -> "exploring"
        | Playing -> "playing"
        | ``Doing Something`` -> "doing something"
        | Socializing -> "socializing"
    let Create (s:string) =
        if s = null then Choice2Of2 ["Behavior cannot be NULL"]
        else if s = "" then Choice2Of2 ["Behavior cannot be empty"]
        else
            match s.ToLower() with
            | "eating" -> Choice1Of2 Eating
            | "drinking" -> Choice1Of2 Drinking
            | "walking" -> Choice1Of2 Walking
            | "standing" -> Choice1Of2 Standing
            | "exploring" -> Choice1Of2 Exploring
            | "playing" -> Choice1Of2 Playing
            | "doing something" -> Choice1Of2 ``Doing Something``
            | "socializing" -> Choice1Of2 Socializing
            | _ -> Choice2Of2 [String.Format("{0} is not a valid Behavior", s)]

module Observation =
    type _T = {
        LocationName: Location._T;
        ElephantName: Elephant._T;
        ElephantStatus: Status._T;
        ElephantActivity: Behavior._T list;
    }
    let Create (l:string) (e:string) (s:string) (b:string list) =
        let makeObservation ll ee ss bb = {LocationName = ll; ElephantName = ee; ElephantStatus = ss; ElephantActivity = bb}
        let apply f x =
            match f, x with
            | Choice1Of2 f, Choice1Of2 x   -> Choice1Of2 (f x)
            | Choice2Of2 e, Choice1Of2 x   -> Choice2Of2 e
            | Choice1Of2 f, Choice2Of2 e   -> Choice2Of2 e
            | Choice2Of2 e1, Choice2Of2 e2 -> Choice2Of2 (e1 @ e2)
        let combine f x =
            match f, x with
            | Choice1Of2 f, Choice1Of2 x   -> Choice1Of2 (f @ x)
            | Choice2Of2 e, Choice1Of2 x   -> Choice2Of2 e
            | Choice1Of2 f, Choice2Of2 e   -> Choice2Of2 e
            | Choice2Of2 e1, Choice2Of2 e2 -> Choice2Of2 (e1 @ e2)
        let applyFor1 f x =
            match x with
            | Choice1Of2 v -> Choice1Of2 (f v)
            | Choice2Of2 e -> Choice2Of2 e
 
        let (<*>) = apply
        let (<+>) = combine
        let bs = if obj.ReferenceEquals(b, Unchecked.defaultof<string list>) then Choice2Of2 ["Activities cannot be NULL"]
                    elif b.Length = 0 then Choice2Of2 ["Activities cannot be empty"]
                    else b |> List.map Behavior.Create |> List.map (applyFor1 (fun x -> [x])) |> List.reduce combine
        (Choice1Of2 makeObservation) <*> Location.Create(l) <*> Elephant.Create(e) <*> Status.Create(s) <*> bs



open Observation

type ObservationController() =
    inherit ApiController()

    member this.Get() =
        this.Request.CreateResponse(
            HttpStatusCode.OK,
            { Message = "Hello World!" })

    member this.Post(reqObj : ObservationPostRequest) =
        let obs = Observation.Create reqObj.Location reqObj.Elephant reqObj.Status reqObj.Activities
        match obs with
        | Choice1Of2 ob -> this.Save ob
        | Choice2Of2 validationErrors -> this.Request.CreateResponse(HttpStatusCode.BadRequest, validationErrors)
    member private this.Save(obs: Observation._T) =
        use connection = new SQLiteConnection(Config.ConnectionString)
        connection.Open() |> ignore
        use command = new SQLiteCommand(connection)
        command.CommandText <- "INSERT INTO Observation(Elephant, Social, Location, Activity) VALUES(@elephant, @social, @location, @activity);"
        command.Parameters.AddWithValue("@elephant", Elephant.value obs.ElephantName) |> ignore
        command.Parameters.AddWithValue("@social", Status.value obs.ElephantStatus) |> ignore
        command.Parameters.AddWithValue("@location", Location.value obs.LocationName) |> ignore
        command.Parameters.AddWithValue("@activity", "XXXX") |> ignore
        command.ExecuteNonQuery() |> ignore
        this.Request.CreateResponse(
            HttpStatusCode.OK,
            "Observation recorded"
        )

Requirement

{ 
"location" : "NorthMeadow",
"elephant" : "Packy",
"status" : "Alone",
"behaviors" : ["playing","exploring"]
}
 
Valid values for the location field are:
NorthMeadow, EncounterHabitat, SouthHabitat, ForestHall, ElephantPool
 
Valid values for the elephant field are:
Chendra, Lily, Packy, Rose-Tu, Samudra, Sung-Surin, Tusko
 
Valid values for the status field are:
alone, with herdmates
 
The behaviors field holds an array containing at least 1, but no more than 3 valid behaviors.  Valid behaviors are:
eating, drinking, walking, standing, exploring, socializing, playing, doing something
 
The "alone" status cannot be in the same report as the "socializing" behavior - this is enforced application-side while users are filling out their report.