Commits

Robert Pickering  committed 50427d5

Add some stuff that I need to get another project going.

  • Participants
  • Parent commits 72e3b94

Comments (0)

Files changed (5)

File src/app/FunctionalNHibernate/FSharpRecordTuplizer.fs

         mappedProperty.GetGetter(mappedEntity.MappedClass)
     override x.BuildPropertySetter(mappedProperty, mappedEntity) =
         logger.Debug(sprintf "BuildPropertySetter")
-        let field = mappedEntity.MappedClass.GetField(mappedProperty.Name + "@", BindingFlags.Instance ||| BindingFlags.NonPublic) 
+        let field = mappedEntity.MappedClass.GetField(mappedProperty.Name + "@", BindingFlags.Instance ||| BindingFlags.NonPublic||| BindingFlags.Public) 
         let makeSetter func =
             { new ISetter with
                 member x.Set(target, value) = 

File src/app/FunctionalNHibernate/Mapping.fs

 
 /// Returns a FunctionalClassMap
 let ClassMap<'a> = ClassMapWithConvention<'a> []
-  
-/// Maps a property to a database id field.
-let Id (quote:Expr<'a -> 'b>) : 'a FieldMap =
+
+let private id (quote:Expr<'a -> 'b>) generator: 'a FieldMap  =
       let prop = Helpers.propOfQuote quote
       IdMap  { Property = { PropertyName = prop.Name;
                             ColumnName = None;
                             PropertyType = prop.PropertyType;
-                            DatabaseType = None;
+                            DatabaseType = NoType;
+                            Length = None;
+                            Index = None;
                             IsReference = false} 
-               GeneratorClass = Identity }
+               GeneratorClass = generator }
+  
+/// Maps a property to a database id field.
+let Id (quote:Expr<'a -> 'b>) : 'a FieldMap =
+    id quote Identity
+
+/// Maps a property to a database id field with an assigned id.
+let IdAssigned (quote:Expr<'a -> 'b>) : 'a FieldMap =
+    id quote Assigned
+
+/// Maps a property to a database id field with a custom generator.
+let IdCustom (quote:Expr<'a -> 'b>) clr: 'a FieldMap =
+    id quote (Custom clr)
+
 
 let internal createProperty (quote:Expr<'a -> 'b>) isReference : 'a FieldMap = 
       let prop = Helpers.propOfQuote quote
                   { PropertyName = prop.Name;
                     ColumnName = None;
                     PropertyType = prop.PropertyType;
-                    DatabaseType = None;
+                    DatabaseType = NoType;
+                    Length = None;
+                    Index = None;
                     IsReference  = isReference  })
 
 /// Maps a property to a database field.
 /// Modifies the ColumnName
 let ColumnName name = ModifyProperty (fun p -> {p with ColumnName = Some name})
 
+/// Sets a clr custom type for the given field
+let CustomClrTypeIs t = ModifyProperty (fun p -> {p with DatabaseType = CustomColumnClrType t})    
+
 /// Sets a custom type for the given field
-let CustomTypeIs t = ModifyProperty (fun p -> {p with DatabaseType = Some t})    
+let CustomTypeIs typename sqlname = ModifyProperty (fun p -> {p with DatabaseType = CustomColumnType (typename, sqlname)})    
+
+/// Sets the length of the column
+let WithLengthOf length = ModifyProperty (fun p -> {p with Length = Some length})
+
+/// Sets the length of the column
+let Index name = ModifyProperty (fun p -> {p with Index = Some name})
+
 
 /// Sets the key columns for a bag
 let KeyColumns columns (map: 'a FieldMap) : 'a FieldMap = 

File src/app/FunctionalNHibernate/MappingSchemaCombinators.fs

 
 type Generator =
     | Identity
+    | Assigned
     | Custom of System.Type
-    | NoGenerator
 
 namespace FunctionalNHibernate.MappingSchemaCombinators
 open System
 
 // These are combinators designed to create an nh XML mapping
 
+type DatabaseColumnType =
+| CustomColumnType of string * string
+| CustomColumnClrType of System.Type
+| NoType
+
 type Property =
     { PropertyName: string;
       ColumnName: string option;
       PropertyType: System.Type;
-      DatabaseType: System.Type option;
+      DatabaseType: DatabaseColumnType;
+      Length: int option;
+      Index: string option;
       IsReference: bool; }
 
-    member x.ToAttribs() =
+    member x.ToPropertyAttribs() =
         let attribs = [ "name", x.PropertyName ]
         if x.IsReference then attribs else
-        match x.DatabaseType with 
-        | Some t -> ("type", t.FullNameAssembly) :: attribs 
-        | None ->  ("type", x.PropertyType.FullNameAssembly) :: attribs
+            let attribs =
+                match x.DatabaseType with
+                | CustomColumnType (name, _) -> ("type", name) :: attribs
+                | CustomColumnClrType t -> ("type", t.FullNameAssembly) :: attribs 
+                | NoType ->  ("type", x.PropertyType.FullNameAssembly) :: attribs
+            let attribs =
+                match x.Length with
+                | Some x -> ("length", string x) :: attribs
+                | None -> attribs
+            match x.Index with
+            | Some x -> ("index", x) :: attribs
+            | None -> attribs
+    member x.ToColumnAttribs() =
+        match x.DatabaseType with
+        | CustomColumnType (_, name) -> ["sql-type", name]
+        | CustomColumnClrType _
+        | NoType ->  []
 
 type IdProperty =
     { Property: Property;
         let createProp prop =
             let tag = if prop.IsReference then "many-to-one" else "property"
             let colName = Option.extract prop.ColumnName prop.PropertyName
-            XmlPrimatives.element tag (prop.ToAttribs()) 
-                (XmlPrimatives.emptyElement "column" [ "name",  colName])
+            XmlPrimatives.element tag (prop.ToPropertyAttribs()) 
+                (XmlPrimatives.emptyElement "column" (("name",  colName) :: (prop.ToColumnAttribs())))
         let createField field =
             match field with
             | PropertyField prop -> createProp prop 
                         let generator = 
                             match id.GeneratorClass with 
                             | Identity -> XmlPrimatives.emptyElement "generator" [ "class", "identity" ]
+                            | Assigned -> XmlPrimatives.emptyElement "generator" [ "class", "assigned" ]
                             | Custom t -> XmlPrimatives.emptyElement "generator" [ "class", t.FullNameAssembly ]
-                            | NoGenerator -> XmlPrimatives.empty
-                        XmlPrimatives.elementSubElems "id" (id.Property.ToAttribs()) 
-                            [ (XmlPrimatives.emptyElement "column" [ "name",  colName]);
+                        XmlPrimatives.elementSubElems "id" (id.Property.ToPropertyAttribs()) 
+                            [ (XmlPrimatives.emptyElement "column" (("name",  colName) :: (id.Property.ToColumnAttribs())));
                               generator ]
                     | ids ->
                         // TODO generators are ignored ... which is shoddy

File src/app/FunctionalNHibernate/Query.fs

     /// Returns the result as a list
     let toList = Seq.toList
 
+    /// Returns the result sort by the chosen element
+    let sortBy orderColumn (query: 'a queryable) : 'a queryable = 
+        query.OrderBy(ToLinq orderColumn) :> 'a queryable
+
+    /// Returns the result sort by the chosen element
+    let sortByDesc orderColumn (query: 'a queryable) : 'a queryable = 
+        query.OrderByDescending(ToLinq orderColumn) :> 'a queryable
+
     /// Returns the element count without filtering.
     let count<'a> : int query = create<'a> >> length
 

File src/app/FunctionalNHibernate/SessionFactoryHelper.fs

 module SessionHelper =
     /// Saves or updates the given value
     let saveOrUpdate x (session:ISession) = session.SaveOrUpdate x
+    /// Saves the given value
+    let save x (session:ISession) = session.Save x |> ignore
+    /// Updates the given value
+    let update x (session:ISession) = session.Update x
 
 [<AutoOpen>]
 module SessionFactoryExtension =