namespace Units

type MeasureType =
    | BaseUnit of string
    | Multiple of Measure * ValueType
    with
    member this.BaseUnitName =
        let rec traverse = function
            | BaseUnit s -> s
            | Multiple(Measure(_,m),_) -> traverse m
        traverse this
and Measure = Measure of string * MeasureType with
    member this.Name = match this with Measure(s,_) -> s
    member this.Type = match this with Measure(_,t) -> t
    static member Giga (m:Measure) =
        Measure("G"+m.Name,Multiple(m,1000000000.0))
    static member Mega (m:Measure) =
        Measure("M"+m.Name,Multiple(m,1000000.0))
    static member Kilo (m:Measure) =
        Measure("k"+m.Name,Multiple(m,1000.0))
    static member Deci (m:Measure) =
        Measure("d"+m.Name,Multiple(m,0.1))
    static member Centi (m:Measure) =
        Measure("c"+m.Name,Multiple(m,0.01))
    static member Milli (m:Measure) =
        Measure("m"+m.Name,Multiple(m,0.001))
    static member Micro (m:Measure) =
        Measure("µ"+m.Name,Multiple(m,0.0001))
    static member ( * ) (v:ValueType,m:Measure) = UnitValue(v,Unit(m,1))
and UnitType =
    | Unit of Measure * int
    | CompositeUnit of UnitType list
    static member Create(m) = Unit(m,1)
    override this.ToString() =
        let exponent = function
            | Unit(_,n) -> n
            | CompositeUnit(_) ->
                raise (new System.InvalidOperationException())
        let rec toString = function
            | Unit(s,n) when n=0 -> ""
            | Unit(Measure(s,_),n) when n=1 -> s
            | Unit(Measure(s,_),n)          -> s + " ^ " + n.ToString()
            | CompositeUnit(us) ->
                let ps, ns =
                    us |> List.partition (fun u -> exponent u >= 0)
                let join xs =
                    let s = xs |> List.map toString |> List.toArray
                    System.String.Join(" ",s)
                match ps,ns with
                | ps, [] -> join ps
                | ps, ns ->
                    let ns = ns |> List.map UnitType.Reciprocal
                    join ps + " / " + join ns
        match this with
        | Unit(_,n) when n < 0 -> " / " + toString this
        | _ -> toString this
    static member ( * ) (v:ValueType,u:UnitType) = UnitValue(v,u)
    static member ( * ) (lhs:UnitType,rhs:UnitType) =
        let text = function
            | Unit(Measure(s,_),_) -> s
            | CompositeUnit(us) -> us.ToString()
        let normalize us u =
            let t = text u
            match us |> List.tryFind (fun x -> text x = t), u with
            | Some(Unit(s,n) as v), Unit(_,n') ->
                us |> List.map (fun x -> if x = v then Unit(s,n+n') else x)
            | Some(_), _ -> raise (new System.NotImplementedException())
            | None, _ -> us@[u]
        let normalize' us us' =
            us' |> List.fold (fun (acc) x -> normalize acc x) us
        match lhs,rhs with
        | Unit(u1,p1), Unit(u2,p2) when u1 = u2 ->
            Unit(u1,p1+p2)
        | Unit(u1,p1), Unit(u2,p2) ->
            CompositeUnit([lhs;rhs])
        | CompositeUnit(us), Unit(_,_) ->
            CompositeUnit(normalize us rhs)
        | Unit(_,_), CompositeUnit(us) ->
            CompositeUnit(normalize' [lhs]  us)
        | CompositeUnit(us), CompositeUnit(us') ->
            CompositeUnit(normalize' us us')
        | _,_ -> raise (new System.NotImplementedException())
    static member Reciprocal x =
        let rec reciprocal = function
            | Unit(s,n) -> Unit(s,-n)
            | CompositeUnit(us) -> CompositeUnit(us |> List.map reciprocal)
        reciprocal x
    static member ( / ) (lhs:UnitType,rhs:UnitType) =
        lhs * (UnitType.Reciprocal rhs)
    static member ( + ) (lhs:UnitType,rhs:UnitType) =
        if lhs = rhs then lhs
        else raise (new System.InvalidOperationException())
and ValueType = float
and UnitValue = UnitValue of ValueType * UnitType with
    member this.Value = match this with UnitValue(v,_) -> v
    member this.Unit = match this with UnitValue(_,u) -> u
    override this.ToString() = sprintf "%O %O" this.Value this.Unit
    member this.ToBaseUnit() =
        let rec toBaseUnit = function
            | UnitValue(v,(Unit(Measure(_,BaseUnit(_)),_))) as x ->
                x
            | UnitValue(v,Unit(Measure(_,Multiple(quantity,coefficient)),p)) ->
                toBaseUnit (UnitValue(v*coefficient, Unit(quantity,p)))
            | UnitValue(v,(CompositeUnit(xs))) ->
                let v, ys =
                    (v,[]) |> List.foldBack (fun x (v,ys) ->
                        let x = toBaseUnit (UnitValue(v,x))
                        x.Value, x.Unit::ys
                    ) xs
                UnitValue(v, CompositeUnit(ys))
        toBaseUnit this
    static member private DoesDimensionalUnitMismatchExist lhs rhs =
        let rec measures = function
            | Unit(m,_) -> Set.singleton (m)
            | CompositeUnit(us) ->
                us |> List.map measures |> Set.unionMany
        measures lhs |> Set.exists (fun x ->
            measures rhs |> Set.exists (fun y ->
                y.Type.BaseUnitName = x.Type.BaseUnitName
                && not (x = y)
            )
        )
    static member (+) (lhs:UnitValue,rhs:UnitValue) =
        if lhs.Unit = rhs.Unit then
            UnitValue(lhs.Value+rhs.Value, lhs.Unit+rhs.Unit)
        else
            let x1 = lhs.ToBaseUnit()
            let x2 = rhs.ToBaseUnit()
            if x1.Unit = x2.Unit then
                UnitValue(x1.Value+x2.Value,x1.Unit+x2.Unit)
            else
                raise (new System.InvalidOperationException())
    static member (*) (lhs:UnitValue,rhs:UnitValue) =
        if UnitValue.DoesDimensionalUnitMismatchExist lhs.Unit rhs.Unit then
            let lhs = lhs.ToBaseUnit()
            let rhs = rhs.ToBaseUnit()
            UnitValue(lhs.Value*rhs.Value,lhs.Unit*rhs.Unit)
        else
            UnitValue(lhs.Value*rhs.Value,lhs.Unit*rhs.Unit)
    static member (*) (lhs:UnitValue,rhs:ValueType) =
        UnitValue(lhs.Value*rhs,lhs.Unit)
    static member (/) (lhs:UnitValue,rhs:UnitValue) =
        if UnitValue.DoesDimensionalUnitMismatchExist lhs.Unit rhs.Unit then
            let lhs = lhs.ToBaseUnit()
            let rhs = rhs.ToBaseUnit()
            UnitValue(lhs.Value/rhs.Value,lhs.Unit/rhs.Unit)
        else
            UnitValue(lhs.Value/rhs.Value,lhs.Unit/rhs.Unit)
    static member (/) (lhs:UnitValue,rhs:ValueType) =
        UnitValue(lhs.Value/rhs,lhs.Unit)

module SI =

    let length = "length"
    let time = "time"
    let m = Measure("m", BaseUnit(length))
    let km = Measure.Kilo(m)
    let s = Measure("s", BaseUnit(time))
    let milliseconds = Measure.Milli(s)