f# inireader

open System
open System.Runtime
open System.Text
open System.Text.RegularExpressions
open System.IO
open System.Linq

open Microsoft.FSharp.Reflection

///Match the pattern using a cached compiled Regex
let (|CompiledMatch|_|) pattern input =
    if input = null then None
    else
        let m = Regex.Match(input, pattern, RegexOptions.Compiled)
        if m.Success then Some [for x in m.Groups -> x]
        else None

///Returns the case name of the object with union type 'ty.
let GetUnionCaseName (x:'a) =
    match FSharpValue.GetUnionFields(x, typeof<'a>) with
    | case, _ -> case.Name

type Directive = {
    name: string;
    argCount: int;
}

let directives = [
    { name = "inherit"; argCount = 1; }
]

type DirectiveLine = {
    directive: Directive;
    args: seq<string>;
}
with
    static member Parse (line: string) =
        let splitLine = line.Substring(1).TrimStart().Split(" \t".ToCharArray())
        let partsCount = Seq.length splitLine
        if partsCount < 1 then
            None
        else
            match Seq.tryFind (fun its -> its.name = Seq.head splitLine && (partsCount - 1) >= its.argCount ) directives with
            | Some(dir) ->
                Some { directive = dir; args = Seq.take dir.argCount (Seq.skip 1 splitLine) }
            | _ -> None




type Line =
    | Empty
    | Comment
    | Directive of DirectiveLine
    | SectionHead of string
    | KeyValuePair of string*string
    with
        static member ParseLine (line:string) =
            match line with
            | empty when String.IsNullOrWhiteSpace empty -> Empty
            | comment when comment.StartsWith(";") ->
                match DirectiveLine.Parse comment with
                | Some(dir) -> Directive dir
                | None -> Comment
            | CompiledMatch @"^\s*\[(\w+)\]\s*$" [_; sectionHead] -> SectionHead sectionHead.Value
            | CompiledMatch @"^\s*([^=]+?)=(.+)$" [_; key; value] -> KeyValuePair (key.Value,value.Value)
            | _ -> Empty

type ParserState = {
    directives: list<DirectiveLine>;

    section: string option;

    globals: list<string*string>;
    sections: list<string*string*string>;
} with
    member x.updateFromParent (parent: ParserState)=
        { x with
            globals = List.concat [x.globals; (List.filter (fun i -> not (List.exists (fun ex -> fst i = fst ex) x.globals)) parent.globals)]
            sections = List.concat [x.sections; (List.filter (fun (sec, key, _) -> not (List.exists (fun (exsec, exkey, __) -> sec = exsec && key = exkey) x.sections)) parent.sections) ]
        }
    static member Default = {
        directives = [];

        section = None;

        globals = [];
        sections = [];
    }

type IniFile ={
    Globals: list<string*string>;
    Sections: list<string*string*string>;
} with
    static member fromParser (ps: ParserState) =
        {
            Globals = ps.globals;
            Sections = ps.sections
        }

let processLine (line: string) (state: ParserState) =
    printf "Parsing line: %s\n" line
    let parsedLine = Line.ParseLine line
    printf "Parsed line: %s\n" (GetUnionCaseName parsedLine)
    match parsedLine with
    | Empty -> state
    | Comment -> state
    | Directive d -> {state with directives = d :: state.directives }
    | SectionHead sh -> { state with section = Some sh }
    | KeyValuePair (k,p) ->
        match state.section with
        | Some(sect) -> {state with sections = (sect, k, p) :: state.sections }
        | _ -> {state with globals = (k, p) :: state.globals }

let processLines (lines: seq<string>): ParserState =
    Seq.fold (fun ps line -> processLine line ps) ParserState.Default lines

let readSingleFile (filename: string) =
    processLines (File.ReadLines(filename, Encoding.UTF8))

let resolveFileName basePath relativeOrAbsolute =
    Path.Combine(Path.GetDirectoryName basePath, relativeOrAbsolute)

//DFS topological sort for resolving
let rec readIniInternal
    (filesproceesed: Map<string, ParserState>)
    (filename: string)
    (parents: list<string>)
    (maxRequestedReferenceDepth:int) =
        if Seq.length parents >= maxRequestedReferenceDepth then
            failwith "Recursion depth exceeded"
        else
        if List.exists (fun i -> i = filename) parents then
            failwithf "Recursion encountered on path %s in file %s" (String.Join(", ", parents)) filename
        else
            match Map.tryFind filename filesproceesed with
            | Some(inifile) -> (inifile, filesproceesed)
            | None ->
                let parser = readSingleFile filename
                parser.directives
                |> List.filter (fun dir -> dir.directive.name = "inherit")
                |> List.fold (fun (upFile, processed) inhDir ->
                    let resolvedFileName = resolveFileName filename (inhDir.args.First())
                    let procedfle, allprocd = readIniInternal processed resolvedFileName (filename :: parents) maxRequestedReferenceDepth
                    (parser.updateFromParent procedfle, Map.add resolvedFileName procedfle allprocd)
                    ) (parser, filesproceesed)

let readIni (filename: string): IniFile =
    let maxDepth = 12
    IniFile.fromParser (fst (readIniInternal Map.empty (resolveFileName Environment.CurrentDirectory filename) List.empty maxDepth))