LineItem-BrandTrait.fs

 module T =
    open System

    type Brand<'tag, 'b>(value: obj) = 
        member this.Apply() : 'c = value :?> _

    [<Trait>]
    type IBrand<'Kind, 'Tag, 'a> =
        abstract inj: 'Kind -> Brand<'Tag, 'a> 
        abstract prj: Brand<'Tag, 'a> -> 'Kind

    type Decision<'a> = Decision of 'a

    type InProgress = class end
    type Finished = class end
    type Cancelled = class end

    type InProgress<'a> = {value: 'a; decision: Decision<'a>}
    type Finished<'a> = {value: 'a; initial: 'a; timestamp: DateTime}
    type Cancelled<'a> = {value: 'a; decisions: list<Decision<'a>>; timestamp: DateTime; reason: string}

    [<Witness>] 
    type InProgressBrand<'a> =
        interface IBrand<InProgress<'a>, InProgress,'a> with
            member this.inj v = new Brand<_,_>(v)
            member this.prj v = v.Apply() 

    [<Witness>] 
    type FinishedBrand<'a> =
        interface IBrand<Finished<'a>,Finished, 'a> with
            member this.inj v = new Brand<_,_>(v)
            member this.prj v = v.Apply() 

    [<Witness>] 
    type CancelledBrand<'a> =
        interface IBrand<Cancelled<'a>, Cancelled,'a> with
            member this.inj v = new Brand<_,_>(v)
            member this.prj v = v.Apply() 

    let inj x = x |> IBrand.inj
    let prj x = x |> IBrand.prj

    let transitF f = fun x -> x |> prj |> f |> inj
    
    let applyDecision (Decision d) v = d

    [<Trait>]
    type Transition<'a, 'b> =
        abstract member transit: 'a -> 'b

    [<Witness>] 
    type TransitionInProgressFinished<'a> =
        interface Transition<InProgress<'a>, Finished<'a>> with
            member __.transit {value = v; decision = d} = {value = applyDecision d v; initial = v; timestamp = DateTime.Now}

    [<Witness>] 
    type TransitionFinishedInProgress<'a> =
        interface Transition<Finished<'a>,InProgress<'a>> with
            member __.transit {value = v; initial = d} = {InProgress.value = v; decision = Decision d}

    [<Witness>] 
    type TransitionInProgressCancelled<'a> =
        interface Transition<InProgress<'a>,Cancelled<'a>> with
            member __.transit {value = v; decision = d} = {value = applyDecision d v; timestamp = DateTime.Now; decisions = [d]; reason = "reason"}

    let transit x = x |> prj |> Transition.transit |> inj
    
    type LineItem<'a> = {
        articleID: Brand<'a,string>
        units:     Brand<'a,int>
        amount:    Brand<'a,float>
    }

    let mapLineItem li = 
        {
            articleID   = li.articleID |> transit
            units       = li.units |> transit
            amount      = li.amount |> transit
        }
    
    let a:LineItem<InProgress> = {
        articleID = inj {InProgress.value = "foo"; decision = Decision "goo"}
        units = inj {InProgress.value = 1; decision = Decision 2}
        amount = inj {InProgress.value = 1.0; decision = Decision 2.0}
    }

    let print {articleID = a; units = u; amount = m} =
        prj a |> printfn "%A" 
        prj u |> printfn "%A" 
        prj m |> printfn "%A" 

    a |> print

    let f:LineItem<Finished> = (a |> mapLineItem):LineItem<Finished>
    // warning FS3218: Multiple solutions to trait 'LineItem.2.T.Transition<LineItem.2.T.InProgress<Microsoft.FSharp.Core.string>,'?8922>'; 
    // using 'LineItem.2.T.TransitionInProgressCancelled<'?9128>' (possibilities are 'LineItem.2.T.TransitionInProgressCancelled<'?9128>', 'LineItem.2.T.TransitionInProgressFinished<'?9129>')
    
    // error FS3216: No solution to trait 'LineItem.2.T.IBrand<LineItem.2.T.Cancelled<Microsoft.FSharp.Core.string>,LineItem.2.T.Finished,Microsoft.FSharp.Core.string>'
    // error FS0071: Type constraint mismatch when applying the default type 'obj' for a type inference variable. The type 'obj' is not compatible with the type 'T.IBrand<T.Cancelled<string>,T.Finished,string>' Consider adding further type constraints

    f |> print
    let c:LineItem<Cancelled> = a |> mapLineItem 
    c |> print
    f |> mapLineItem |> print