Commits

Maxim Moiseev  committed 12b9727

parser combinators used to process json arrays

  • Participants
  • Parent commits 9121fd2

Comments (0)

Files changed (6)

File src/Common/Conversions.fs

+namespace Linq2vk.Core
+
+[<RequireQualifiedAccess>] 
+module Conversions =
+    open System
+    open JsonParser
+    open Linq2vk.Core.Implementation.DataKind
+    
+    let apply parser xs =
+        JsonParser.parse parser (Seq.toArray xs)
+    
+    let toFriend = function
+        | JsonArr arr -> apply Parsers.friend arr
+        | _ -> raise <| NotSupportedException "Conversion only supported for JsonArr"
+        
+    let toItemArray conv = function
+        |JsonArr arr -> arr |> Seq.map (string >> conv) |> Seq.toArray
+        | _ -> raise <| NotSupportedException "Conversion only supported for JsonArr"
+
+    let toStatus = function
+        | JsonArr arr ->
+            apply Parsers.status arr
+        | JsonData o ->
+            apply Parsers.status (o.PropertyValues())
+        | _ -> raise <| NotSupportedException "Conversion only supported for JsonArr or JsonData"
+
+    let toPhoto = function
+        | JsonArr arr -> apply Parsers.photo arr
+        | _ -> raise <| NotSupportedException "Conversion only supported for JsonArr"
+
+    // TODO: implement a Json Object parsers equivalent to Json Array parsers to handle this kind of situation
+    open Tools
+    let toUserProfile = function
+        | JsonData o ->
+            { new IUserProfile with
+                override this.UserId = o.["id"] |> int64
+                override this.FirstName = o.["fn"] |> string'
+                override this.LastName = o.["ln"] |> string'
+                override this.MaidenName = o.["mn"] |> string'
+                override this.CurrentStatus = o.["actv"] |> string |> toStatus
+                override this.CountryId = o.["ht"].["coi"] |> int64
+                override this.ISOCountryCode = o.["ht"].["con"] |> string'
+                override this.CityId = o.["ht"].["cii"] |> int64
+                override this.CityName = o.["ht"].["cin"] |> string'
+                override this.Gender = o.["sx"] |> int |> enum<Gender>
+                override this.PhotoUrl = o.["bp"] |> string'
+                override this.BirthdayDay = o.["bd"] |> int
+                override this.BirthdayMonth = o.["bm"] |> int
+                override this.BirthdayYear = o.["by"] |> int
+                override this.MaritalStatus = o.["fs"] |> int |> enum<MaritalStatus>
+                override this.PoliticalViews = o.["pv"] |> int |> enum<PoliticalViews>
+                override this.Friends = o.["fr"].["d"] |> string |> toItemArray toFriend
+                override this.FriendsOnline = o.["fro"].["d"] |> string |> toItemArray toFriend
+                override this.FriendsMutual = o.["frm"].["d"] |> string |> toItemArray toFriend
+                override this.UploadedPhotos = o.["ph"].["d"] |> string |> toItemArray toPhoto
+                override this.PhotosWith = o.["phw"].["d"] |> string |> toItemArray toPhoto
+            }
+        | _ -> raise <| NotSupportedException "Conversion only supported for JsonData"
+        
+    let toMessage = function
+        | JsonArr arr -> apply Parsers.message arr
+        | _ -> raise <| NotSupportedException "Conversion only supported for JsonArr"

File src/Common/Data.fs

     abstract Sender : IUserDescriptor
     abstract Recipient : IUserDescriptor
     abstract IsRead : bool
-
-[<AutoOpen>]
-module Tools =
-    open Newtonsoft.Json.Linq        
-    open System.Text.RegularExpressions
-    
-    let unquote (s:string) =
-        s.[1..(s.Length-2)]
-        
-    let string' = unquote << string
-    
-    let anyString (token:JToken) =
-        if token.Type = JTokenType.String then
-            token |> string |> unquote
-        else
-            token |> string
-    
-    let intBool (token:JToken) =
-        0 <> (token |> int)
-
-    let UnixTimeStart = DateTime(1970, 1, 1)
-    let fromUnixtime (x:int64) = 
-         UnixTimeStart + TimeSpan.FromSeconds(x |> float)
-
-    let parseTimestamp (token:JToken) =
-        anyString token |> int64 |> fromUnixtime
-
-    let parseComplexId id =
-        let idRx = Regex("([0-9]+)_([\-0-9]+)")
-        let m = idRx.Match(id)
-        let parseGroup (i:int) =
-            m.Groups.[i].Value |> int64
-        
-        if m.Success then 
-            (parseGroup 1, parseGroup 2)
-        else
-            raise <| ArgumentException(sprintf "Invalid complex id format: %s" id)
-            
-    let optional<'T> (tokens:JToken[]) (index:int) convert =
-        if index < tokens.Length then
-            convert tokens.[index]
-        else
-            Unchecked.defaultof<'T>
-        
-            
-         
-
-[<RequireQualifiedAccess>]
-module Make =
-    open Newtonsoft.Json.Linq        
-           
-    let friend (ts:JToken[]) =
-        { new IFriend with 
-            override this.Id = ts.[0] |> int64
-            override this.Name = ts.[1] |> string'
-            override this.PhotoUrl = ts.[2] |> string'
-            override this.IsOnline = ts.[3] |> intBool
-        }
-
-    let status (ts:JToken[]) =
-        let (_, statusId) = parseComplexId (ts.[0] |> string)
-        { new IStatus with
-            override this.Id = ts.[0] |> string
-            override this.UserId = ts.[1] |> int64
-            override this.StatusId = statusId
-            override this.Reserved = 0
-            override this.Name = ts.[3] |> string'
-            override this.Timestamp = 
-                if statusId <> -1L then
-                    parseTimestamp ts.[4]
-                else
-                    DateTime.MinValue
-            override this.Text = ts.[5] |> string'
-        }
-        
-    let photo (ts:JToken[]) =
-        let (ownerId, photoId) = parseComplexId (ts.[0] |> string)
-        { new IPhoto with
-            override this.Id = ts.[0] |> string
-            override this.OwnerId = ownerId
-            override this.PhotoId = photoId
-            override this.ThumbnailUrl = ts.[1] |> string'
-            override this.ImageUrl = ts.[2] |> string'
-        }
-        
-    let userDescriptor (ts:JToken[]) =
-        { new IUserDescriptor with
-            override this.UserId = ts.[0] |> anyString |> int64
-            override this.UserName = optional<string> ts 1 string'
-            override this.PhotoUrl = optional<string> ts 2 anyString
-            override this.ThumbnailFileName = optional<string> ts 3 anyString
-            override this.Gender = optional<Gender> ts 4 (int >> enum<Gender>)
-            override this.IsOnline = optional<bool> ts 5 intBool
-        }
-        
-    let message (ts:JToken[]) =
-        { new IMessage with
-            override this.MessageId = ts.[0] |> anyString |> int64
-            override this.Timestamp = parseTimestamp ts.[1]
-            override this.Text = (Seq.toArray ts.[2]).[0] |> string'
-            override this.Sender = userDescriptor (Seq.toArray ts.[3])
-            override this.Recipient = userDescriptor (Seq.toArray ts.[4])
-            override this.IsRead = ts.[5] |> intBool
-        }
-       
-[<RequireQualifiedAccess>] 
-module Conversions =
-    open Linq2vk.Core.Implementation.DataKind
-    
-    let toFriend = function
-        | JsonArr arr -> Make.friend (Seq.toArray arr)
-        | _ -> raise <| NotSupportedException "Conversion only supported for JsonArr"
-        
-    let toItemArray conv = function
-        |JsonArr arr -> arr |> Seq.map (string >> conv) |> Seq.toArray
-        | _ -> raise <| NotSupportedException "Conversion only supported for JsonArr"
-
-    let toStatus = function
-        | JsonArr arr ->
-            Make.status (Seq.toArray arr)
-        | JsonData o ->
-            Make.status (Seq.toArray (o.PropertyValues()))
-        | _ -> raise <| NotSupportedException "Conversion only supported for JsonArr or JsonData"
-
-    let toPhoto = function
-        | JsonArr arr -> Make.photo (Seq.toArray arr)
-        | _ -> raise <| NotSupportedException "Conversion only supported for JsonArr"
-
-    let toUserProfile = function
-        | JsonData o ->
-            { new IUserProfile with
-                override this.UserId = o.["id"] |> int64
-                override this.FirstName = o.["fn"] |> string'
-                override this.LastName = o.["ln"] |> string'
-                override this.MaidenName = o.["mn"] |> string'
-                override this.CurrentStatus = o.["actv"] |> string |> toStatus
-                override this.CountryId = o.["ht"].["coi"] |> int64
-                override this.ISOCountryCode = o.["ht"].["con"] |> string'
-                override this.CityId = o.["ht"].["cii"] |> int64
-                override this.CityName = o.["ht"].["cin"] |> string'
-                override this.Gender = o.["sx"] |> int |> enum<Gender>
-                override this.PhotoUrl = o.["bp"] |> string'
-                override this.BirthdayDay = o.["bd"] |> int
-                override this.BirthdayMonth = o.["bm"] |> int
-                override this.BirthdayYear = o.["by"] |> int
-                override this.MaritalStatus = o.["fs"] |> int |> enum<MaritalStatus>
-                override this.PoliticalViews = o.["pv"] |> int |> enum<PoliticalViews>
-                override this.Friends = o.["fr"].["d"] |> string |> toItemArray toFriend
-                override this.FriendsOnline = o.["fro"].["d"] |> string |> toItemArray toFriend
-                override this.FriendsMutual = o.["frm"].["d"] |> string |> toItemArray toFriend
-                override this.UploadedPhotos = o.["ph"].["d"] |> string |> toItemArray toPhoto
-                override this.PhotosWith = o.["phw"].["d"] |> string |> toItemArray toPhoto
-            }
-        | _ -> raise <| NotSupportedException "Conversion only supported for JsonData"
-        
-    let toMessage = function
-        | JsonArr arr ->
-            Make.message (Seq.toArray arr)
-        | _ -> raise <| NotSupportedException "Conversion only supported for JsonArr"
-    

File src/Common/JsonParser.fs

+namespace Linq2vk.Core
+
+module JsonParserImpl =
+    open Newtonsoft.Json.Linq
+
+    type JsonParser<'a> =
+        JsonParser of (JToken[] -> ('a * JToken[]) list)
+        
+    let runParser (JsonParser p) tokens =
+        p tokens
+        
+        
+    type JsonParserException(msg:string) =
+        inherit System.Exception(msg)        
+    
+    let getParsingResult = function
+        | [] -> raise <| JsonParserException("Parsing failed")
+        | [(res, _)] -> res
+        | _ -> raise <| System.NotSupportedException("This should not normally happen")
+
+    type JsonBuilder() = 
+        member this.Return(x) =
+            JsonParser (fun ts -> [(x, ts)])
+        member this.Fail() =
+            JsonParser (fun _ -> [])
+        member this.Zero() =
+            JsonParser (fun _ -> [])
+        member this.Bind(p, f) =
+            JsonParser (fun ts ->
+                match runParser p ts with
+                | [(r, ts')] -> runParser (f r) ts'
+                | _ -> []
+            )
+
+module JsonParser =             
+    open JsonParserImpl
+    
+    let json = JsonBuilder()
+    
+    let at idx =
+        JsonParser (fun ts ->
+            if ts.Length <> 0 && idx < ts.Length then
+                [(ts.[idx]), ts]
+            else
+                []
+        )
+        
+    let parse parser tokens =
+        runParser parser tokens
+            |> getParsingResult
+    
+    let parseOrDefault parser defaultValue =
+        JsonParser (fun ts ->
+            match runParser parser ts with
+            | [] -> [(defaultValue, ts)]
+            | res -> res
+        )
+        
+    let (<|>) = parseOrDefault
+    
+    let parseOrFail condition parser =
+        JsonParser (fun ts ->
+            if condition then
+                runParser parser ts
+            else
+                []
+        )
+        
+    let (<?>) = parseOrFail
+    
+    let tokenAtAs idx converter =
+        json {
+            let! t = at idx
+            return (converter t)
+        }
+        
+    let (<@>) converter idx =
+        tokenAtAs idx converter
+        
+        
+#if DEBUG
+// simple tests to be used in REPL
+//
+module JsonParserTests =
+    open JsonParser
+    open Newtonsoft.Json.Linq
+
+    let singleItemParser =        
+        json {
+            let! a =  int <@> 0
+            let! c = (string <@> 2) <|> "default"
+            return (a,c)
+        }
+
+    let tokens = JArray.Parse("[1,2]") |> Seq.toArray
+    let a = parse singleItemParser tokens
+#endif

File src/Common/Parsers.fs

+namespace Linq2vk.Core
+
+open Linq2vk.Core.JsonParser
+
+module Tools =
+    open System
+    open Newtonsoft.Json.Linq        
+    open System.Text.RegularExpressions
+    
+    let unquote (s:string) =
+        s.[1..(s.Length-2)]
+        
+    let string' = unquote << string
+    
+    let anyString (token:JToken) =
+        if token.Type = JTokenType.String then
+            token |> string |> unquote
+        else
+            token |> string
+    
+    let intBool (token:JToken) =
+        0 <> (token |> int)
+
+    let UnixTimeStart = DateTime(1970, 1, 1)
+    let fromUnixtime (x:int64) = 
+         UnixTimeStart + TimeSpan.FromSeconds(x |> float)
+
+    let parseTimestamp (token:JToken) =
+        anyString token |> int64 |> fromUnixtime
+
+    let parseComplexId id =
+        let idRx = Regex("([0-9]+)_([\-0-9]+)")
+        let m = idRx.Match(id)
+        let parseGroup (i:int) =
+            m.Groups.[i].Value |> int64
+        
+        if m.Success then 
+            (parseGroup 1, parseGroup 2)
+        else
+            raise <| ArgumentException(sprintf "Invalid complex id format: %s" id)
+            
+    let asArray (token:JToken) =
+        Seq.toArray token
+    let childToken idx (token:JToken) =
+        (asArray token).[idx]
+            
+
+[<RequireQualifiedAccess>]
+module Parsers =
+    open System
+    open Tools
+
+    let friend =
+        json {
+            let! id = int64 <@> 0
+            let! name = string' <@> 1
+            let! photo = string' <@> 2
+            let! isOnline = intBool <@> 3
+
+            return {
+                new IFriend with 
+                    override this.Id = id
+                    override this.Name = name
+                    override this.PhotoUrl = photo
+                    override this.IsOnline = isOnline
+            }
+        }
+        
+    let status =
+        json {
+            let! id = string <@> 0
+            let! userId = int64 <@> 1
+            let! (_, statusId) = (parseComplexId << string) <@> 0
+            let! name = string' <@> 3
+            let! timestamp = (statusId <> -1L) <?> (parseTimestamp <@> 4) <|> DateTime.MinValue
+            let! text = string' <@> 5
+            return {
+                new IStatus with
+                    override this.Id = id
+                    override this.UserId = userId
+                    override this.StatusId = statusId
+                    override this.Reserved = 0
+                    override this.Name = name
+                    override this.Timestamp = timestamp
+                    override this.Text = text
+              }
+        }
+        
+    let photo =
+        json {
+            let! id = string <@> 0
+            let! (ownerId, photoId) = (parseComplexId << string) <@> 0
+            let! thumbnailUrl = string' <@> 1
+            let! imageUrl = string' <@> 2
+            return {
+                new IPhoto with
+                    override this.Id = id
+                    override this.OwnerId = ownerId
+                    override this.PhotoId = photoId
+                    override this.ThumbnailUrl = thumbnailUrl
+                    override this.ImageUrl = imageUrl
+            }
+        }
+    
+    let userDescription =
+        json {
+            let! userId = (int64 << anyString) <@> 0
+            let! name = string' <@> 1 <|> String.Empty
+            let! photoUrl = anyString <@> 2 <|> String.Empty
+            let! thumbnailFileName = anyString <@> 3 <|> String.Empty
+            let! gender = (enum<Gender> << int) <@> 4 <|> Gender.Male
+            let! isOnline = intBool <@> 5 <|> false
+            return {
+                new IUserDescriptor with
+                    override this.UserId = userId
+                    override this.UserName = name
+                    override this.PhotoUrl = photoUrl
+                    override this.ThumbnailFileName = thumbnailFileName
+                    override this.Gender = gender
+                    override this.IsOnline = isOnline
+            }
+        }
+        
+    let message =
+        json {
+            let! messageId = (int64 << anyString) <@> 0
+            let! timestamp = parseTimestamp <@> 1
+            let! text = (childToken 0 >> string) <@> 2
+            let! sender = (parse userDescription << asArray) <@> 3
+            let! recipient = (parse userDescription << asArray) <@> 4
+            let! isRead = intBool <@> 5
+            return {
+                new IMessage with
+                    override this.MessageId = messageId
+                    override this.Timestamp = timestamp
+                    override this.Text = text
+                    override this.Sender = sender
+                    override this.Recipient = recipient
+                    override this.IsRead = isRead
+                }
+        }
+        

File src/Linq2vk.Core.Silverlight/Linq2vk.Core.Silverlight.fsproj

     <Compile Include="..\Common\DataKind.fs">
       <Link>DataKind.fs</Link>
     </Compile>
+    <Compile Include="..\Common\JsonParser.fs">
+      <Link>JsonParser.fs</Link>
+    </Compile>
     <Compile Include="..\Common\Data.fs">
       <Link>Data.fs</Link>
     </Compile>
+    <Compile Include="..\Common\Parsers.fs">
+      <Link>Parsers.fs</Link>
+    </Compile>
+    <Compile Include="..\Common\Conversions.fs">
+      <Link>Conversions.fs</Link>
+    </Compile>
     <Compile Include="..\Common\Net.fs">
       <Link>Net.fs</Link>
     </Compile>

File src/Linq2vk.Core/Linq2vk.Core.fsproj

     <Compile Include="..\Common\DataKind.fs">
       <Link>DataKind.fs</Link>
     </Compile>
+    <Compile Include="..\Common\JsonParser.fs">
+      <Link>JsonParser.fs</Link>
+    </Compile>
     <Compile Include="..\Common\Data.fs">
       <Link>Data.fs</Link>
     </Compile>
+    <Compile Include="..\Common\Parsers.fs">
+      <Link>Parsers.fs</Link>
+    </Compile>
+    <Compile Include="..\Common\Conversions.fs">
+      <Link>Conversions.fs</Link>
+    </Compile>
     <Compile Include="..\Common\Net.fs">
       <Link>Net.fs</Link>
     </Compile>