// Copyright (c) Microsoft Open Technologies, Inc.  All Rights Reserved.  Licensed under the Apache License, Version 2.0.  See License.txt in the project root for license information.

namespace Microsoft.FSharp.Compiler

#if EXTENSIONTYPING

open System
open Microsoft.FSharp.Compiler.Range
open Microsoft.FSharp.Core.CompilerServices
open Microsoft.FSharp.Compiler.AbstractIL.IL
open Microsoft.FSharp.Compiler.AbstractIL.Internal.Library 
open System.Reflection
open System.Collections.Generic
open ErrorLogger

type internal TypeProviderError
    (
        errNum : int,
        tpDesignation : string,
        m:Microsoft.FSharp.Compiler.Range.range,
        errors : string list,
        typeNameContext : string option,
        methodNameContext : string option
    ) =

    inherit System.Exception()

    new((errNum, msg : string), tpDesignation,m) = 
        TypeProviderError(errNum, tpDesignation, m, [msg])
    
    new(errNum, tpDesignation, m, messages : seq<string>) =         
        TypeProviderError(errNum, tpDesignation, m, List.ofSeq messages, None, None)

    member this.Number = errNum
    member this.Range = m

    override this.Message = 
        match errors with
        | [text] -> text
        | inner -> 
            // imitates old-fashioned behavior with merged text
            // usually should not fall into this case (only if someone takes Message directly instead of using Iter)
            inner            
            |> String.concat Environment.NewLine

    member this.MapText(f, tpDesignation, m) = 
        let (errNum : int), _ = f ""
        new TypeProviderError(errNum, tpDesignation, m,  (Seq.map (f >> snd) errors))

    member this.WithContext(typeNameContext:string, methodNameContext:string) = 
        new TypeProviderError(errNum, tpDesignation, m, errors, Some typeNameContext, Some methodNameContext)

    // .Message is just the error, whereas .ContextualErrorMessage has contextual prefix information
    // for example if InvokeCode in provided method is not set or has value that cannot be translated -then initial TPE will be wrapped in
    // TPE having type\method name as contextual information
    // without context: Type Provider 'TP' has reported the error: MSG
    // with context: Type Provider 'TP' has reported the error in method M of type T: MSG
    member this.ContextualErrorMessage= 
        match typeNameContext, methodNameContext with
        | Some tc, Some mc ->
            let _,msgWithPrefix = FSComp.SR.etProviderErrorWithContext(tpDesignation, tc, mc, this.Message)
            msgWithPrefix
        | _ ->
            let _,msgWithPrefix = FSComp.SR.etProviderError(tpDesignation, this.Message)
            msgWithPrefix
    
    /// provides uniform way to handle plain and composite instances of TypeProviderError
    member this.Iter f = 
        match errors with
        | [_] -> f this
        | errors ->
            for msg in errors do
                f (new TypeProviderError(errNum, tpDesignation, m, [msg], typeNameContext, methodNameContext))

type TaintedContext = { TypeProvider : ITypeProvider; TypeProviderAssemblyRef : ILScopeRef }

[<NoEquality>][<NoComparison>] 
type internal Tainted<'T> (context : TaintedContext, value : 'T) =
    do
        match box context.TypeProvider with 
        | null -> 
            assert false
            failwith "null ITypeProvider in Tainted constructor"
        | _ -> ()

    member this.TypeProviderDesignation = 
        context.TypeProvider.GetType().FullName

    member this.TypeProviderAssemblyRef = 
        context.TypeProviderAssemblyRef

    member this.Protect f  (range:range) =
        try 
            f value
        with
            |   :? TypeProviderError -> reraise()
            |   :? AggregateException as ae ->
                    let errNum,_ = FSComp.SR.etProviderError("", "")
                    let messages = [for e in ae.InnerExceptions -> e.Message]
                    raise <| TypeProviderError(errNum, this.TypeProviderDesignation, range, messages)
            |   e -> 
                    let errNum,_ = FSComp.SR.etProviderError("", "")
                    raise <| TypeProviderError((errNum, e.Message), this.TypeProviderDesignation, range)

    member this.TypeProvider = Tainted<_>(context, context.TypeProvider)

    member this.PApply(f,range:range) = 
        let u = this.Protect f range
        Tainted(context, u)

    member this.PApply2(f,range:range) = 
        let u1,u2 = this.Protect f range
        Tainted(context, u1), Tainted(context, u2)

    member this.PApply3(f,range:range) = 
        let u1,u2,u3 = this.Protect f range
        Tainted(context, u1), Tainted(context, u2), Tainted(context, u3)

    member this.PApply4(f,range:range) = 
        let u1,u2,u3,u4 = this.Protect f range
        Tainted(context, u1), Tainted(context, u2), Tainted(context, u3), Tainted(context, u4)

    member this.PApplyNoFailure f = this.PApply (f, range0)

    member this.PApplyWithProvider(f,range:range) = 
        let u = this.Protect (fun x -> f (x,context.TypeProvider)) range
        Tainted(context, u)

    member this.PApplyArray(f,methodName,range:range) =        
        let a = this.Protect f range
        match a with 
        |   null -> raise <| TypeProviderError(FSComp.SR.etProviderReturnedNull(methodName), this.TypeProviderDesignation, range)
        |   _ -> a |> Array.map (fun u -> Tainted(context,u))


    member this.PApplyOption(f,range:range) =        
        let a = this.Protect f range
        match a with 
        | None ->  None
        | Some x -> Some (Tainted(context,x))

    member this.PUntaint(f,range:range) = this.Protect f range
    member this.PUntaintNoFailure f = this.PUntaint(f, range0)
    /// Access the target object directly. Use with extreme caution.
    member this.AccessObjectDirectly = value

    static member CreateAll(providerSpecs : (ITypeProvider * ILScopeRef) list) =
        [for (tp,nm) in providerSpecs do
             yield Tainted<_>({ TypeProvider=tp; TypeProviderAssemblyRef=nm },tp) ] 

    member this.OfType<'U> () =
        match box value with
        |   :? 'U as u -> Some (Tainted(context,u))
        |   _ -> None

    member this.Coerce<'U> (range:range) =
        Tainted(context, this.Protect(fun value -> box value :?> 'U) range)

module internal Tainted =
    let (|Null|_|) (p:Tainted<'T>) =
        if p.PUntaintNoFailure(fun p -> match p with null -> true | _ -> false) then Some() else None

    let Eq (p:Tainted<'T>) (v:'T) = p.PUntaintNoFailure((fun pv -> pv = v))

    let EqTainted (t1:Tainted<'T>) (t2:Tainted<'T>) = 
        t1.PUntaintNoFailure(fun t1 -> t1 === t2.AccessObjectDirectly)

    let GetHashCodeTainted (t:Tainted<'T>) = t.PUntaintNoFailure(fun t -> hash t)
    
#endif
    
