/src/Dsl.fs

 1#light
 2
 3namespace FunctionalDivan 
 4
 5module Dsl =
 6    open Divan
 7    open RecordMapping
 8    open Microsoft.FSharp.Reflection
 9    open System.Reflection
10
11    let server address port = CouchServer(address, port)
12    let db name (server: CouchServer) = server.GetDatabase(name)
13    let query design view (db: CouchDatabase) = db.Query(design, view)
14    let byKeys (key: obj[]) (query: CouchQuery) = query.Keys key
15    let byKey (key: obj) (query: CouchQuery) = query.Key key
16    let limitTo limit (query: CouchQuery) = query.Limit limit
17    let offsetBy offset (query: CouchQuery) = query.Skip offset
18    let startAt (startKey: obj) (query: CouchQuery) = query.StartKey startKey
19    let endAt (endKey: obj) (query: CouchQuery) = query.EndKey endKey
20    let startAtId startKey (query: CouchQuery) = query.StartKeyDocumentId startKey
21    let endAtId endKey (query: CouchQuery) = query.EndKeyDocumentId endKey
22    let select (query: CouchQuery) = query.GetResult()
23    let selectDocs<'a when 'a: (new: unit -> 'a) and 'a:> ICouchDocument> (query: CouchQuery) = 
24        List.ofSeq <| query.IncludeDocuments().GetResult().Documents<'a>()
25
26    let selectRecords<'a> (query: CouchQuery) = 
27        let results = (select <| query.IncludeDocuments()).Documents<CouchJsonDocument>()
28        List.ofSeq results |>
29        List.map (fun elem -> (readJson typeof<'a> elem.Obj) :?> 'a) 
30        
31    let from<'a> (db: CouchDatabase) id =
32        let jsonDoc = db.GetDocument(id)
33        if not (jsonDoc = null) then Some <| (readJson typeof<'a> (jsonDoc.Obj) :?> 'a)
34        else None
35        
36    let internal saveRecord (db: CouchDatabase) r includeType =
37        let parms, hasId, hasRev = 
38            Array.fold 
39                (fun s (e: PropertyInfo) -> 
40                            let map, id, rev = s
41                            (Map.add (e.Name) e map, id || e.Name = "id", rev || e.Name = "rev")) 
42                (Map.empty, false, false) 
43                (FSharpType.GetRecordFields(r.GetType()))
44                
45        if not (hasId && hasRev) then
46            failwith "both id and rev are required on the record"
47        else 
48            let _id, _rev = ref (parms.["id"].GetValue(r, null) :?> string), ref (parms.["rev"].GetValue(r, null) :?> string)
49            ignore <| db.SaveDocument
50                { new ICouchDocument with 
51                    member x.ReadJson jObj = ()
52                    member x.WriteJson writer = writeJson r writer includeType
53                    member x.Id with get() = !_id and set v = _id := v
54                    member x.Rev with get() = !_rev and set v = _rev := v }
55            
56            !_id, !_rev
57
58    let into (db: CouchDatabase) r = saveRecord db r true
59
60    let intoSilent (db: CouchDatabase) r = saveRecord db r false
61
62        
63    module Fti =
64        open Divan.Lucene
65    
66        let query name index (db: CouchDatabase) = db.Query(CouchLuceneViewDefinition(index, new CouchDesignDocument(name, db)))
67        let q text (query: CouchLuceneQuery) = query.Q text
68        let limitTo limit (query: CouchLuceneQuery) = query.Limit limit
69        let offsetBy offset (query: CouchLuceneQuery) = query.Skip offset
70        let select (query: CouchLuceneQuery) = query.GetResult()
71        let selectDocs<'a when 'a: (new: unit -> 'a) and 'a:> ICouchDocument> (query: CouchLuceneQuery) = 
72            List.ofSeq <| query.IncludeDocuments().GetResult().GetDocuments<'a>()
73        let selectRecords<'a> (query: CouchLuceneQuery) = 
74            let results = (select <| query.IncludeDocuments()).GetDocuments<CouchJsonDocument>()
75            List.ofSeq results |>
76            List.map (fun elem -> (readJson typeof<'a> elem.Obj) :?> 'a) 
77