// 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 
    open Microsoft.FSharp.Core
    open Microsoft.FSharp.Core.Operators
    open Microsoft.FSharp.Collections
    open Microsoft.FSharp.Reflection
    open System.Globalization
    open System.IO
    open System.Text
    open System.Reflection 
    
    module internal SR =
        let private resources = lazy (new System.Resources.ResourceManager("fsstrings", System.Reflection.Assembly.GetExecutingAssembly()))

        let GetString(name:string) =        
            let s = resources.Force().GetString(name, System.Globalization.CultureInfo.CurrentUICulture)
#if DEBUG
            if null = s then
                System.Diagnostics.Debug.Assert(false, sprintf "**RESOURCE ERROR**: Resource token %s does not exist!" name)
#endif
            s

        let GetObject(name:string) =
            let o = resources.Force().GetObject(name, System.Globalization.CultureInfo.CurrentUICulture)
#if DEBUG
            if null = o then
                System.Diagnostics.Debug.Assert(false, sprintf "**RESOURCE ERROR**: Resource token %s does not exist!" name)
#endif
            o
            
        
    module internal DiagnosticMessage =
    
        open Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators
        open Microsoft.FSharp.Reflection
        open System.Reflection
        open Internal.Utilities.StructuredFormat
  
        let staticInvokeFlags = BindingFlags.Public ||| BindingFlags.InvokeMethod ||| BindingFlags.Static
        let mkFunctionValue (tys: System.Type[]) (impl:obj->obj) = 
            FSharpValue.MakeFunction(FSharpType.MakeFunctionType(tys.[0],tys.[1]), impl)
            
        let funTyC = typeof<(obj -> obj)>.GetGenericTypeDefinition()  
        let mkFunTy a b = funTyC.MakeGenericType([| a;b |])

        let isNamedType(ty:System.Type) = not (ty.IsArray ||  ty.IsByRef ||  ty.IsPointer)
        let isFunctionType (ty1:System.Type)  = 
            isNamedType(ty1) && ty1.IsGenericType && (ty1.GetGenericTypeDefinition()).Equals(funTyC)

        let rec destFunTy (ty:System.Type) =
            if isFunctionType ty then 
                ty, ty.GetGenericArguments() 
            else
                match ty.BaseType with 
                | null -> failwith "destFunTy: not a function type" 
                | b -> destFunTy b 

        let buildFunctionForOneArgPat (ty: System.Type) impl = 
            let _,tys = destFunTy ty 
            let rty = tys.[1]
            // PERF: this technique is a bit slow (e.g. in simple cases, like 'sprintf "%x"') 
            mkFunctionValue tys (fun inp -> impl rty inp)
                    
        let capture1 (fmt:string) i args ty (go : obj list -> System.Type -> int -> obj) : obj = 
            match fmt.[i] with
            | '%' -> go args ty (i+1) 
            | 'd'
            | 'f'
            | 's' -> buildFunctionForOneArgPat ty (fun rty n -> go (n::args) rty (i+1))
            | _ -> failwith "bad format specifier"
            
        // newlines and tabs get converted to strings when read from a resource file
        // this will preserve their original intention    
        let postProcessString (s : string) =
            s.Replace("\\n","\n").Replace("\\t","\t")
            
        let createMessageString (messageString : string) (fmt : Printf.StringFormat<'T>) : 'T = 
            let fmt = fmt.Value // here, we use the actual error string, as opposed to the one stored as fmt
            let len = fmt.Length 

            /// Function to capture the arguments and then run.
            let rec capture args ty i = 
                if i >= len ||  (fmt.[i] = '%' && i+1 >= len) then 
                    let b = new System.Text.StringBuilder()    
                    b.AppendFormat(messageString, (Array.ofList (List.rev args))) |> ignore
                    box(b.ToString())
                // REVIEW: For these purposes, this should be a nop, but I'm leaving it
                // in case we ever decide to support labels for the error format string
                // E.g., "<name>%s<foo>%d"
                elif System.Char.IsSurrogatePair(fmt,i) then 
                   capture args ty (i+2)
                else
                    match fmt.[i] with
                    | '%' ->
                        let i = i+1 
                        capture1 fmt i args ty capture
                    | _ ->
                        capture args ty (i+1) 

            (unbox (capture [] (typeof<'T>) 0) : 'T)
    
        type ResourceString<'T>(fmtString : string, fmt : Printf.StringFormat<'T>) =
            member a.Format =
                createMessageString fmtString fmt
            
        let DeclareResourceString ((messageID : string),(fmt : Printf.StringFormat<'T>)) =
            let mutable messageString = SR.GetString(messageID)
#if DEBUG
            // validate that the message string exists
            let fmtString = fmt.Value
            
            if null = messageString then
                System.Diagnostics.Debug.Assert(false, sprintf "**DECLARED MESSAGE ERROR** String resource %s does not exist" messageID)
                messageString <- ""
            
            // validate the formatting specifiers
            let countFormatHoles (s : string) =
                // remove escaped format holes
                let s = s.Replace("{{","").Replace("}}","")
                let len = s.Length - 2
                let mutable pos = 0
                let mutable nHoles = 0
                let mutable order = Set.empty<int>
    
                while pos < len do
                    if s.[pos] = '{' then
                        let mutable pos' = pos+1
                        while System.Char.IsNumber(s.[pos']) do
                            pos' <- pos' + 1
                        if pos' > pos+1 && s.[pos'] = '}' then
                            nHoles <- nHoles + 1
                            let ordern = (int) (s.[(pos+1) .. (pos'-1)])
                            order <- order.Add(ordern)
                            pos <- pos'
                    pos <- pos + 1
                // the sort should be unnecessary, but better safe than sorry
                nHoles,Set.toList order |> List.sort |> List.rev

            let countFormatPlaceholders (s : string) =
                // strip any escaped % characters - yes, this will fail if given %%%...
                let s = s.Replace("%%","")
                
                if s = "" then 
                    0
                else
                    let len = s.Length - 1
                    let mutable pos = 0
                    let mutable nFmt = 0
                
                    while pos < len do
                        if s.[pos] = '%' && 
                          (s.[pos+1] = 'd' || s.[pos+1] = 's' || s.[pos+1] = 'f') then
                            nFmt <- nFmt + 1
                            pos <- pos + 2 ;
                        else
                            pos <- pos + 1 ;
                    nFmt
                    
            let nHoles,holes = countFormatHoles messageString
            let nPlaceholders = countFormatPlaceholders fmtString
            
            // first, verify that the number of holes in the message string does not exceed the 
            // largest hole reference
            if holes <> [] && holes.[0] > nHoles - 1 then
                System.Diagnostics.Debug.Assert(false, sprintf "**DECLARED MESSAGE ERROR** Message string %s contains %d holes, but references hole %d" messageID nHoles holes.[0])
                
            // next, verify that the number of format placeholders is the same as the number of holes
            if nHoles <> nPlaceholders then
                System.Diagnostics.Debug.Assert(false, sprintf "**DECLARED MESSAGE ERROR** Message string %s contains %d holes, but its format specifier contains %d placeholders" messageID nHoles nPlaceholders)
                
 #endif            
            messageString <- postProcessString messageString                            
            new ResourceString<'T>(messageString, fmt)
