Separated models, controllers and routers

Core/Browser.module.fs

@@ -0,0 +1,29 @@
+module Browser
+
+open System
+open System.IO
+open Microsoft.AspNetCore.Builder
+open Microsoft.AspNetCore.Http
+open Microsoft.AspNetCore.Routing
+open Microsoft.Extensions.DependencyInjection
+open Microsoft.Extensions.Hosting
+open DredgeFramework
+
+
+let cookieExists name (context: HttpContext) =
+    context.Request.Cookies.ContainsKey(name)
+
+let deleteCookie name (context: HttpContext) =
+    if cookieExists name context then context.Response.Cookies.Delete(name)
+
+let getCookie cookieName (context: HttpContext) =
+    context.Request.Cookies[cookieName] |? ""
+
+let setCookie name value (expiry: DateTimeOffset) (context: HttpContext) =
+    deleteCookie name context
+    let options = CookieOptions()
+    options.Expires <- expiry
+    context.Response.Cookies.Append(name, value, options);
+
+let redirect url (context: HttpContext) =
+    context.Response.Redirect url

Core/Database.module.fs

@@ -0,0 +1,46 @@
+module db
+
+open Dapper
+open Dapper.FSharp
+open Dapper.FSharp.PostgreSQL
+
+
+open DredgeFramework
+
+let connString = "Server=localhost;Port=5432;User Id=postgres;Password=root;Database=dredgepos;Include Error Detail=true"
+//let connString = "server=localhost;uid=root;pwd=;database=dredgepos;table cache = false"
+let connection = new Npgsql.NpgsqlConnection(connString)
+
+let Select<'a> asyncQuery =
+    asyncQuery
+        |> connection.SelectAsync<'a>
+        |> RunSynchronously
+        |> EnumerableToArray
+
+let SelectJoin<'a, 'b> asyncQuery =
+    asyncQuery
+        |> connection.SelectAsync<'a, 'b>
+        |> RunSynchronously
+        |> EnumerableToArray
+
+let Insert<'a> asyncQuery =
+    asyncQuery
+        |> connection.InsertAsync<'a>
+        |> RunSynchronously
+
+let InsertOutput<'a> asyncQuery =
+    asyncQuery
+        |> connection.InsertOutputAsync<'a, 'a>
+        |> RunSynchronously
+        |> EnumerableToArray
+
+let Update<'a> asyncQuery =
+    asyncQuery
+        |> connection.UpdateOutputAsync<'a, 'a>
+        |> RunSynchronously
+        |> EnumerableToArray
+
+let Delete<'a> asyncQuery =
+    asyncQuery
+        |> connection.DeleteAsync
+        |> RunSynchronously

Core/DredgeFramework.module.fs

@@ -0,0 +1,103 @@
+module DredgeFramework
+
+open System.Collections.Generic
+open System.Globalization
+open FSharp.Data.Sql
+open System
+open System.Drawing
+open System.IO
+open System.Linq
+open System.Xml;
+open System.Xml.XPath;
+open System.Xml.Xsl
+open FSharp.Reflection
+
+open Thoth.Json.Net
+
+let (|?) lhs rhs = if lhs = null then rhs else lhs
+
+let joinWithNewLine (arr: string[]) = arr |> String.concat "\n"
+
+let getCurrentVenue () = 1
+
+let map list = list |> Map.ofList
+
+let JoinArray (char: string) (array: 'a[]) = String.Join(char, array)
+
+let StringReplace (search:string) (replace:string) (string:string) = (search, replace) |> string.Replace
+
+let StringTrim (string: string) = string.Trim()
+
+let StringSplit (separator: string) (string: string) =
+    string.Split separator
+            |> Array.map(fun s -> s.Trim())
+let EnumerableToArray (enumerable: IEnumerable<'T>) =  enumerable.ToArray()
+
+let getFileExtension (file: string) =  Path.GetExtension file
+
+let GetFileContents (file: string) = File.ReadAllText file
+let GetFileName (file: string) = Path.GetFileName file
+
+let length (variable: 'T[]) = variable.Length
+let first (array: 'a[]) = array[0]
+
+let last (array: 'a[]) = array[array.Length-1]
+
+let filterFirst (array:'a[]) = if array.Length > 0 then [|array[0]|] else [||]
+
+let removeFalseValues (variable: bool[]) = variable |> Array.filter id
+
+let jsonEncode variable = Encode.Auto.toString(4, variable)
+
+let isOk result =
+    match result with
+    | Ok _ -> true
+    | Error _ -> false
+
+let isError result = result |> isOk |> not
+
+let getOk result =
+    match result with
+    | Ok response -> response
+    | Error message -> failwith message
+
+let applyXSLTransform xmlString (xslFile: string) =
+    let processor = XslCompiledTransform()
+    processor.Load(xslFile)
+    use xmlReader = XmlReader.Create(new StringReader(xmlString))
+    use resultWriter = new StringWriter()
+    processor.Transform(xmlReader, null, resultWriter)
+    resultWriter |> string
+
+let RunSynchronously task =
+    task
+    |> Async.AwaitTask
+    |> Async.RunSynchronously
+
+let AppendToArray (element: 'T) (array : 'T[]) = Array.append [|element|] array
+
+let ToLowerCase (string: string) = string.ToLower()
+let ToUpperCase (string: string) = string.ToUpper()
+let ToTitleCase (string: string) = CultureInfo.CurrentCulture.TextInfo.ToTitleCase <| string
+
+let recordToMap (record: 'T) =
+    seq {
+        for prop in FSharpType.GetRecordFields(typeof<'T>) -> prop.Name, prop.GetValue(record) |> string
+    }
+    |> Map.ofSeq
+
+let status (status: string) result =
+    map [
+        "status", status
+        "data", (jsonEncode result)
+    ]
+
+let ajaxFail data = status "fail" data
+let ajaxSuccess data = status "success" data
+
+let loadImage image = Image.FromFile image
+let GetImageSize image =
+    let loadedImage = loadImage image
+    loadedImage.Width, loadedImage.Height
+
+let CurrentTime() = DateTimeOffset.Now.ToUnixTimeSeconds() |> int

Core/GenericEntities.module.fs

@@ -0,0 +1,76 @@
+module Entity
+open Dapper.FSharp
+open DredgeFramework
+open Pluralize.NET.Core
+open FSharp.Reflection
+
+let GetDatabaseTable<'x> =
+        let typeName = typeof<'x>.Name
+        Pluralizer().Pluralize typeName
+
+let Create (record: 'x)=
+    let tableName = GetDatabaseTable<'x>
+    insert {
+        table tableName
+        value record
+        excludeColumn "id"
+    }
+    |> db.InsertOutput
+    |> first
+
+
+let inline Update (record: ^x) =
+    let tableName = GetDatabaseTable<'x>
+    let id = ((^x) : (member id : int) record)
+    update {
+        table tableName
+        set record
+        where (eq "id" id)
+        excludeColumn "id"
+    }
+    |> db.Update
+
+let GetAll<'x> =
+    let tableName = GetDatabaseTable<'x>
+
+    select {
+        table tableName
+    }
+    |> db.Select<'x>
+
+let GetAllByColumn<'x> (column: string) (value: obj) =
+    let tableName = GetDatabaseTable<'x>
+
+    select {
+        table tableName
+        where (eq column value)
+    } |> db.Select<'x>
+
+let GetAllInVenue<'x> = GetAllByColumn<'x> "venue_id" (getCurrentVenue ())
+let GetById<'x> (id: int) = GetAllByColumn<'x> "id" id |> first
+
+let inline GetRelated<'x, .. > (entity: ^y) =
+    let columnName = typeof<'x>.Name + "_id"
+    let primaryKeyValue = typeof<'y>.GetProperty(columnName).GetValue(entity) :?> int
+    GetById<'x> primaryKeyValue
+
+let inline GetAllRelated<'x, .. > (entity: ^y) =
+    let id = typeof<'y>.GetProperty("id").GetValue(entity) :?> int
+    let columnName = typeof<'y>.Name + "_id"
+    GetAllByColumn<'x> columnName id
+
+let DeleteById<'x> id =
+    let typeName = typeof<'x>.Name
+    let tableName = Pluralizer().Pluralize typeName
+    let entity = GetById<'x>  id
+
+    delete {
+        table tableName
+        where (eq "id" id)
+    } |> db.Delete |> ignore
+
+    entity
+
+let inline Delete< ^x when  ^x: (member id: int) > (entity: ^x) =
+    typeof<'x>.GetProperty("id").GetValue(entity) :?> int
+    |> DeleteById<'x>

Core/Language.module.fs

@@ -0,0 +1,33 @@
+module language
+
+open System.IO
+open System.Text.RegularExpressions
+open Thoth.Json.Net
+open FSharp.Data
+let defaultLanguage = "english"
+let languageFile =  "wwwroot/languages/" + defaultLanguage + "/main.json"
+let languageData = languageFile |> File.ReadAllText
+
+
+//Returns an array of all language variables as defined in the the language file.
+let languageVars =
+    languageData
+        |> Decode.unsafeFromString (Decode.keyValuePairs Decode.string)
+        |> Map.ofList
+
+
+//Gets a value of a language variable
+let get var =
+    if languageVars.ContainsKey var then
+        languageVars[var]
+    else
+        "Missing language variable: " + var
+
+let getAndReplace languageVar (replacements: 'x list) =
+    let langString = get languageVar
+    replacements
+        |> List.mapi (fun index replacement
+                       -> index + 1, replacement.ToString())
+        |> List.fold (fun (result: string) (index, string)
+                         -> result.Replace($"[{index}]", string)
+                      ) langString

Core/Theme.module.fs

@@ -0,0 +1,155 @@
+module Theme
+
+open System.Web
+open System.IO
+open System.Collections.Generic
+open System.Text.RegularExpressions
+open FSharp.Core
+open DredgeFramework
+
+let currentTheme = "restaurant"
+
+let getHTMLForFile file =
+    let stylePath = $"/styles/css/{file}"
+    let scriptPath = $"/scripts/js/{file}"
+    let fileExtension = file |> getFileExtension
+    let scriptFileExists =  File.Exists ("wwwroot"+stylePath) || File.Exists("wwwroot"+scriptPath)
+    match scriptFileExists with
+        | true ->
+            match fileExtension with
+            | ".css" -> $"\t<link rel=\"stylesheet\" href=\"{stylePath}\" />"
+            | ".js" ->
+                    let snippet = $"\t<script src=\"{scriptPath}\"></script>"
+                    snippet
+            | _ -> ""
+        | false -> $"\t<!--Missing File: {file}-->"
+
+
+let ParseScriptsAndStylesheets files html =
+    let defaultScriptsAndStyles = ["dark.theme.css"; "../external/jquery.js" ; "dredgepos.core.js"; "keyboards.js";]
+    let scriptsAndStylesheets = defaultScriptsAndStyles @ files
+
+    let scriptAndStylesheetHTML =
+        scriptsAndStylesheets
+            |> List.map getHTMLForFile
+            |> String.concat("\n")
+
+    html |> StringReplace "</head>" (scriptAndStylesheetHTML + "\n</head>")
+
+
+let titlePrefix title = title + " | DredgePos"
+
+let ParseVariables (varArray: Map<string, string>) (html:string) =
+    Regex.Replace(html, "<!--\[var\:(.*?)\]-->",
+        MatchEvaluator(
+            fun matchedVar ->
+                let varName = matchedVar.Groups[1] |> string |> StringTrim
+
+                if varArray.ContainsKey varName then
+                    if varName |> ToLowerCase = "title" then titlePrefix varArray[varName]
+                    else varArray[varName]
+                else
+                    ""
+    ))
+
+let ParseArrays (arrayArray: Map<string, Map<string, string>>) (string:string) =
+    Regex.Replace(string, "<!--\[arr\:(.*?)\|(.*?)\]-->",
+        MatchEvaluator(
+            fun matchedVar ->
+                let arrayName = matchedVar.Groups[1].ToString() |> StringTrim
+                let keyName = matchedVar.Groups[2].ToString()
+
+                if arrayArray.ContainsKey arrayName && arrayArray[arrayName].ContainsKey keyName then
+                    arrayArray[arrayName][keyName]
+                else
+                   "<!--[Undefined Array: " + arrayName + "]-->"
+        )
+    )
+
+let ParseSimpleLanguageVariables (string:string) =
+    Regex.Replace(string, "<!--\[lang\:(.*?)\]-->",
+        new MatchEvaluator(
+            fun matchedVar ->
+                let varName = matchedVar.Groups[1].ToString()
+                              |> StringTrim
+
+                language.get varName
+        ))
+
+let ParseLanguageVariablesWithReplacements (string: string) =
+    Regex.Replace(string, "<!--\[lang\:(.*?)\|(.*?)\]-->",
+        MatchEvaluator(
+            fun matchedVar ->
+                let varName = matchedVar.Groups[1].ToString()
+                let replacements = matchedVar.Groups[2].ToString()
+                                   |> StringSplit ","
+                                   |> Array.toList
+
+                language.getAndReplace varName replacements
+        ))
+
+let getTemplateFilePath templateName =
+    "wwwroot/themes/"+ currentTheme + "/" + templateName + ".tpl.htm"
+
+let templateExists templateName =
+   templateName
+   |> getTemplateFilePath
+   |> File.Exists
+
+let openTemplateFile templateName =
+    if templateExists templateName then
+        templateName |> getTemplateFilePath |> File.ReadAllText
+    else
+        "<!--[Missing Template: " + templateName + "]-->"
+
+let rec loadTemplateWithVarsArraysScriptsAndStyles templateName vars arrays scripts styles =
+        templateName
+            |> openTemplateFile
+            |> ParseVariables vars
+            |> ParseArrays arrays
+            |> ParseLanguageVariablesWithReplacements
+            |> ParseSimpleLanguageVariables
+            |> ParseTemplates vars arrays scripts styles
+            |> ParseScriptsAndStylesheets (scripts @ styles)
+
+and ParseTemplates vars arrays scripts styles (string: string) =
+    Regex.Replace(string, "<!--\[template\:(.*?)\]-->",
+        new MatchEvaluator( fun template ->
+            let templateName = template.Groups[1].ToString() |> StringTrim
+            loadTemplateWithVarsArraysScriptsAndStyles templateName vars arrays scripts styles
+        ))
+
+let loadTemplate templateName =
+    loadTemplateWithVarsArraysScriptsAndStyles templateName Map.empty<string, string> Map.empty<string, Map<string, string>> [] []
+
+let loadTemplateWithArrays templateName arrays =
+    loadTemplateWithVarsArraysScriptsAndStyles templateName Map.empty arrays [] []
+
+let loadTemplateWithVars templateName vars =
+    loadTemplateWithVarsArraysScriptsAndStyles templateName vars Map.empty<string, Map<string, string>> [] []
+
+let loadTemplateWithVarsAndArrays templateName vars arrs =
+    loadTemplateWithVarsArraysScriptsAndStyles templateName vars arrs [] []
+
+let loadTemplateWithVarsAndScripts templateName vars scripts =
+    loadTemplateWithVarsArraysScriptsAndStyles templateName vars Map.empty<string, Map<string, string>> scripts []
+
+let loadTemplateWithVarsAndStyles = loadTemplateWithVarsAndScripts
+
+let loadTemplateWithVarsScriptsAndStyles templateName vars scripts styles =
+    loadTemplateWithVarsArraysScriptsAndStyles templateName vars Map.empty<string, Map<string, string>> scripts styles
+
+
+let htmlAttributes (attributes: Map<string, string>) =
+    " " + (attributes
+        |> Map.toArray
+        |> Array.map (fun (attribute, value) -> attribute+"='"+HttpUtility.HtmlEncode value + "'")
+        |> String.concat " ")
+
+let PosButton (text: string) (classes: string) (attributes: string) =
+    let vars = map [
+        "text", text
+        "classes", classes
+        "attributes", attributes
+    ]
+    loadTemplateWithVars "components/posButton" vars

Core/Types.fs

@@ -0,0 +1,112 @@
+module DredgePos.Types
+
+[<CLIMutable>]
+type reservation = {
+    id: int
+    name: string
+    time: int
+    covers: int
+    floorplan_table_id: int
+    created_at: int
+}
+
+[<CLIMutable>]
+type venue = {
+    id: int
+    venue_name: string
+}
+
+[<CLIMutable>]
+type floorplan_table = {
+    table_number: int
+    room_id: int
+    venue_id: int
+    pos_x: int
+    pos_y: int
+    shape: string
+    width: int
+    height: int
+    default_covers: int
+    rotation: int
+    merged_children: string
+    previous_state: string
+    status: int
+    id: int
+}
+
+[<CLIMutable>]
+type print_group = {
+    id: int
+    name: string
+    printer: int
+    venue_id: int
+}
+
+[<CLIMutable>]
+type sales_category = {
+    id: int
+    parent: int
+    name: string
+    print_group: int
+    venue_id: int
+}
+
+[<CLIMutable>]
+type floorplan_room = {
+    id: int
+    room_name: string
+    background_image: string
+    venue_id: int
+}
+
+[<CLIMutable>]
+type floorplan_decoration = {
+    id: int
+    decoration_room: int
+    decoration_pos_x: int
+    decoration_pos_y: int
+    decoration_rotation: int
+    decoration_width: int
+    decoration_height: int
+    decoration_image: string
+    venue_id: int
+}
+
+[<CLIMutable>]
+type clerk = {id: int; clerk_name: string; clerk_login_code: int; clerk_usergroup: int}
+
+[<CLIMutable>]
+type session = {id: int; session_id: string; clerk_json: string; clerk_id: int; expires: int}
+
+[<CLIMutable>]
+type order_screen_page_group = {id: int; order: int; venue_id: int; label: string; grid_id: int}
+
+[<CLIMutable>]
+type grid = {id: int; grid_name: string; grid_rows: int; grid_cols: int; grid_data: string}
+
+[<CLIMutable>]
+type button = {
+    id: int
+    text: string
+    primary_action: string
+    primary_action_value: string
+    secondary_action: string
+    secondary_action_value: string
+    image: string
+    extra_classes: string
+    extra_styles: string
+}
+
+[<CLIMutable>]
+type item = {
+    id: int
+    item_code: string
+    item_category: int
+    item_name: string
+    item_type: string
+    price1: int
+    price2: int
+    price3: int
+    price4: int
+    price5: int
+}