gistfile1.txt

type Type =
| String of int
| Guid
| Date
| Bool
| Integer
| Enum of name : string

type Property =
    { Name : string
      Type : Type
      DefaultValue : string option }

let prop name ty =
    { Name = name 
      Type = ty 
      DefaultValue = None }
let propDefault name ty def =
    { Name = name 
      Type = ty 
      DefaultValue = Some def }

let templateText = System.IO.File.ReadAllText((__SOURCE_DIRECTORY__ + "\objecttemplate.txt"))

let indentSize = 4
let nl = "\r\n"
let indent count =
    let count = count * indentSize
    nl + System.String(' ', count)

let indentNoNl count =
    let count = count * indentSize
    System.String(' ', count)

let buildStructs properties =
    properties
    |> List.map(fun x ->
        let ty =
            match x.Type with
            | String _ -> "String"
            | Guid -> "Guid"
            | Date -> "Date"
            | Integer -> "Integer"
            | Bool -> "Boolean"
            | Enum x -> x
        sprintf "Dim %s as %s" x.Name ty)
    |> String.concat(indent 2)

let buildInits properties =
    let indentCount = 3
    properties
    |> List.map(fun x ->
        let value =
            match x.DefaultValue with
            | Some x -> x
            | None -> 
                match x.Type with
                | String _ -> "\"\""
                | Guid -> "Guid.Empty"
                | Bool -> "True"
                | Date -> "#12:00:00 AM#"
                | Integer -> "0"
                | Enum x -> failwithf "Enum '%s' must have default value specified" x
        sprintf ".%s = %s" x.Name value)
    |> String.concat(indent 3)

let guidTemplate = 
    """Public Property {name}() As System.Guid Implements I{object_name}.{name}
    Get
        Return m_udtProps.{name}
    End Get
    Set(ByVal value As System.Guid)
        PropertySetEnter()

        If Not value.Equals({name}) Then
            'm_objValid.RuleBroken("{name}", value.Equals(Guid.Empty))
            m_udtProps.{name} = value

            PropertySetChanged("{name}")
        End If
    End Set
End Property"""

let stringTemplate = 
    """Public Property {name}() As String Implements I{object_name}.{name}
    Get
        Return Trim(m_udtProps.{name})
    End Get
    Set(ByVal value As String)
        PropertySetEnter()

        value = Trim(value)

        If value <> {name} Then
            PropertySetStringLength(value, {length}, "{name}")
            'm_objValid.RuleBroken("{name}", (Len(value) = 0))

            m_udtProps.{name} = value

            PropertySetChanged("{name}")
        End If
    End Set
End Property"""

let dateTemplate = 
    """Public Property {name}() As Date Implements I{object_name}.{name}
    Get
        Return m_udtProps.{name}
    End Get
    Set(ByVal value As Date)
        PropertySetEnter()

        If value <> {name} Then
            'm_objValid.RuleBroken("{name}", value = #12:00:00 AM#)

            m_udtProps.{name} = value

            PropertySetChanged("{name}")
        End If
    End Set
End Property"""

let integerTemplate = 
    """Public Property {name}() As Integer Implements I{object_name}.{name}
    Get
        Return m_udtProps.{name}
    End Get
    Set(ByVal value As Integer)
        PropertySetEnter()

        If value <> {name} Then
            'm_objValid.RuleBroken("{name}", value = 0))

            m_udtProps.{name} = value

            PropertySetChanged("{name}")
        End If
    End Set
End Property"""

let booleanTemplate = 
    """Public Property {name}() As Boolean Implements I{object_name}.{name}
    Get
        Return m_udtProps.{name}
    End Get
    Set(ByVal value As Boolean)
        PropertySetEnter()

        If value <> {name} Then
            m_udtProps.{name} = value

            PropertySetChanged("{name}")
        End If
    End Set
End Property"""

let enumTemplate = 
    """Public Property {name}() As {type} Implements I{object_name}.{name}
    Get
        Return m_udtProps.{name}
    End Get
    Set(ByVal value As {type})
        PropertySetEnter()

        If value <> {name} Then
            m_udtProps.{name} = value

            PropertySetChanged("{name}")
        End If
    End Set
End Property"""

let replace (key : string) (value : string) (source : string) =
    source.Replace("{" + key + "}", value)

let buildProp objectName property = 
    let template = 
        match property.Type with
        | String length -> stringTemplate |> replace "length" (length.ToString())
        | Guid -> guidTemplate
        | Date -> dateTemplate
        | Bool -> enumTemplate |> replace "type" "Boolean"
        | Integer -> integerTemplate
        | Enum ty ->
            enumTemplate |> replace "type" ty
    template 
    |> replace "name" property.Name
    |> replace "object_name" objectName

let buildProps objectName (properties : Property list) : string =
    let indent = 1
    properties
    |> List.map(fun x -> 
        let prop = buildProp objectName x
        let lines = prop.Split([| "\r\n"; "\n" |], System.StringSplitOptions.None)
        lines 
        |> Seq.map(fun line -> (indentNoNl 1) + line)
        |> List.ofSeq)
    |> List.concat
    |> String.concat nl

let buildUpdateState properties =
    properties
    |> List.map(fun x ->
        sprintf "UpdateValue(.%s, \"%s\", Record, Method)" x.Name x.Name)
    |> String.concat(indent 3)

let buildColumns properties =
    properties
    |> List.map(fun p ->
        match p.Type with
        | String length -> sprintf "o.AddVarChar(\"%s\", %i)" p.Name length
        | Guid -> sprintf "o.AddUniqueIdentifier(\"%s\")" p.Name
        | Date -> sprintf "o.AddDate(\"%s\")" p.Name
        | Bool -> sprintf "o.AddBoolean(\"%s\")" p.Name
        | Integer -> sprintf "o.AddInteger(\"%s\")" p.Name
        | Enum _ -> sprintf "o.AddInteger(\"%s\")" p.Name)
    |> String.concat(indent 7)

let buildObject initials objectName properties =

    let structs = buildStructs properties
    let inits = buildInits properties
    let props = buildProps objectName properties
    let updateState = buildUpdateState properties
    let columns = buildColumns properties
    let date = (System.DateTime.Now.ToString("yyyy-MM-dd"))
    
    templateText
    |> replace "date" date
    |> replace "initials" initials
    |> replace "object_name" objectName
    |> replace "structs" structs
    |> replace "inits" inits
    |> replace "props" props
    |> replace "update_state" updateState
    |> replace "columns" columns

buildObject "xyz" "ConnectorInfoRecord" [
    prop "ObjectType" (String 1000)
    prop "ObjectID" (String 4000)
    prop "ConnectorInstanceID" (Guid)
    prop "ConnectorID" (String 4000)
    prop "Enabled" (Bool)
]
|> printfn "%s"

buildObject "xyz" "PrintForm" [prop "Name" (String 255)]
|> printfn "%s"

buildObject "xyz" "PrintQueueItem" [
    prop "Name" (String 255)
    prop "DocumentID" Guid
    prop "PrintFormID" Guid
    propDefault "FileType" (Enum "FileTypes") "PDf"
    propDefault "State" (Enum "States") "NotFinished"
    prop "FirstPrinted" Date
    prop "LastPrinted" Date
    prop "TimesPrinted" Integer
    prop "ErrorMessage" (String 16000) ]
|> printfn "%s"

buildObject "xyz" "PrintForm" [prop "Name" (String 255)]
|> printfn "%s"

buildObject "xyz" "PrintQueue" [prop "Name" (String 255)
                                prop "AllowedForms" (String 255)]
|> printfn "%s"

objecttemplate.txt

'{date} {initials}
Option Explicit On
Option Strict On

Imports BirdDogSoftware.Interfaces
Imports BirdDogSoftware.Utilities

Public Class {object_name}
    Inherits BirdDogObject5

    Implements I{object_name}

    ' Private data elements
    Protected Structure {object_name}Props
		{structs}
    End Structure

    Protected m_udtProps As {object_name}Props
    Protected m_udtSave As {object_name}Props

    Public Sub New(Optional ByVal CurrentDataBase As Domain.DataBase = Nothing)

        MyBase.New(CurrentDataBase)

        With m_udtProps
            {inits}
        End With

    End Sub

    Public Sub New(ByVal Record As System.Data.DataRow, Optional ByVal CurrentDataBase As Domain.DataBase = Nothing)

        MyBase.New(Record, CurrentDataBase)

    End Sub

    {props}
	  
    Protected Overrides Sub InitRules(ByRef Broken As Boolean)

        'With m_objValid
        '    .RuleBroken("STRINGPROPERTY", Broken)
        'End With

    End Sub

    Protected Overrides Sub UpdateState(ByVal Record As System.Data.DataRow, ByVal Method As ReadWrite)

        With m_udtProps
            {update_state}
        End With

    End Sub

    Protected Overrides ReadOnly Property TableName() As String
        Get
            Return Table_Name
        End Get
    End Property

    Friend Shared ReadOnly Property Table_Name() As String
        Get
            Return "BD{object_name}s"
        End Get
    End Property

    Protected Overrides ReadOnly Property ObjectName() As String
        Get
            Return "{object_name}"
        End Get
    End Property

    Protected Overrides Sub SaveUndoState()
        m_udtSave = m_udtProps
    End Sub

    Protected Overrides Sub UndoState()
        m_udtProps = m_udtSave
    End Sub

End Class

Public Class {object_name}Collection
    Inherits Domain.DomainCollection

    Implements I{object_name}Collection

    Public Sub New()

    End Sub

    Protected Overrides Function CreateExistingObject(ByVal Record As System.Data.DataRow, Optional ByVal CurrentDataBase As Domain.DataBase = Nothing) As Domain.DomainObject
        Return New {object_name}(Record, CurrentDataBase)
    End Function

    Protected Overrides Function CreateNewObject(Optional ByVal CurrentDataBase As Domain.DataBase = Nothing) As Domain.DomainObject
        Return New {object_name}(CurrentDataBase)
    End Function

    Protected Overrides ReadOnly Property ObjectName() As String
        Get
            Return "{object_name}Collection"
        End Get
    End Property

    Protected Overrides ReadOnly Property TableName() As String
        Get
            Return "BD{object_name}s"
        End Get
    End Property

    Default Public Overloads ReadOnly Property Item(ByVal Index As Integer) As I{object_name} Implements I{object_name}Collection.Item
        Get
            Return CType(InnerList.Item(Index), I{object_name})
        End Get
    End Property

    Default Public Overloads ReadOnly Property Item(ByVal ID As System.Guid) As I{object_name} Implements I{object_name}Collection.Item
        Get

            For Each o{object_name} As I{object_name} In Me
                If o{object_name}.ID.Equals(ID) Then Return o{object_name}
            Next

            Throw New ArgumentOutOfRangeException("Invalid ID:" & ID.ToString)

        End Get
    End Property

    Sub Remove(ByVal {object_name}ID As System.Guid)

        With Item({object_name}ID)
            .Delete()

            .ApplyEdit()
        End With

    End Sub

    Public Overloads Sub Load(ByVal FOREIGNKEYID As Guid)

        LoadEnter()

        Fetch(CreateSql(String.Format("FOREIGNKEYID = '{1}'", FOREIGNKEYID)))

        LoadExit()

    End Sub
End Class

Namespace Revision
    Friend Class {object_name}Table
        Inherits CreationTable

        Friend Shared Sub Update2010(ByVal Version As Integer, ByVal RevLevel As Integer)
            Dim o As New Revision.{object_name}Table

            Select Case Version
                Case CreationTable.Versions.Version9
                    Select Case RevLevel
                        Case 1
                            o.CreateBirdDogObject4Table()

							{columns}
                    End Select
            End Select

        End Sub

        Public Overrides ReadOnly Property TableName() As String
            Get
                Return "BD{object_name}s"
            End Get
        End Property
    End Class
End Namespace