Merge pull request #8 from garyb/types

Add sum for EJson types

Author: garyb

src/Data/Json/Extended.purs

@@ -1,5 +1,5 @@
 module Data.Json.Extended
-  ( module Sig
+  ( module Exports
 
   , EJson(..)
   , getEJson
@@ -17,18 +17,22 @@ module Data.Json.Extended
   , time
   , interval
   , objectId
-  , object
-  , object'
+  , map
+  , map'
   , array
 
   , renderEJson
   , parseEJson
 
   , arbitraryEJsonOfSize
   , arbitraryJsonEncodableEJsonOfSize
+
+  , getType
   ) where
 
-import Prelude
+import Prelude hiding (map)
+
+import Data.Functor as F
 
 import Control.Lazy as Lazy
 
@@ -39,6 +43,7 @@ import Data.Eq1 (eq1)
 import Data.Functor.Mu as Mu
 import Data.HugeNum as HN
 import Data.Json.Extended.Signature as Sig
+import Data.Json.Extended.Type (EJsonType)
 import Data.Map as Map
 import Data.Maybe as M
 import Data.Newtype as N
@@ -52,6 +57,8 @@ import Test.StrongCheck.Arbitrary as SC
 import Test.StrongCheck.Gen as Gen
 import Text.Parsing.Parser as P
 
+import Data.Json.Extended.Signature hiding (getType) as Exports
+
 newtype EJson = EJson (Mu.Mu Sig.EJsonF)
 
 derive instance newtypeEJson :: N.Newtype EJson _
@@ -74,15 +81,15 @@ roll
 roll =
   EJson
     <<< Mu.roll
-    <<< map getEJson
+    <<< F.map getEJson
 
 unroll
   ∷ EJson
   → Sig.EJsonF EJson
 unroll =
   getEJson
     >>> Mu.unroll
-    >>> map EJson
+    >>> F.map EJson
 
 head ∷ EJson → Sig.EJsonF (Mu.Mu Sig.EJsonF)
 head = Mu.unroll <<< getEJson
@@ -200,10 +207,13 @@ objectId = roll <<< Sig.ObjectId
 array ∷ Array EJson → EJson
 array = roll <<< Sig.Array
 
-object ∷ Map.Map EJson EJson → EJson
-object = roll <<< Sig.Object <<< A.fromFoldable <<< Map.toList
+map ∷ Map.Map EJson EJson → EJson
+map = roll <<< Sig.Map <<< A.fromFoldable <<< Map.toList
 
-object' ∷ SM.StrMap EJson → EJson
-object' = roll <<< Sig.Object <<< map go <<< A.fromFoldable <<< SM.toList
+map' ∷ SM.StrMap EJson → EJson
+map' = roll <<< Sig.Map <<< F.map go <<< A.fromFoldable <<< SM.toList
   where
     go (T.Tuple a b) = T.Tuple (string a) b
+
+getType ∷ EJson → EJsonType
+getType = Sig.getType <<< head

src/Data/Json/Extended/Signature/Core.purs

@@ -1,5 +1,6 @@
 module Data.Json.Extended.Signature.Core
   ( EJsonF(..)
+  , getType
   ) where
 
 import Prelude
@@ -9,10 +10,11 @@ import Data.Eq1 (class Eq1)
 import Data.Foldable as F
 import Data.HugeNum as HN
 import Data.Int as Int
+import Data.Json.Extended.Type as T
 import Data.List as L
 import Data.Map as Map
 import Data.Ord1 (class Ord1)
-import Data.Tuple as T
+import Data.Tuple (Tuple)
 
 -- | The signature endofunctor for the EJson theory.
 data EJsonF a
@@ -27,7 +29,7 @@ data EJsonF a
   | Interval String
   | ObjectId String
   | Array (Array a)
-  | Object (Array (T.Tuple a a))
+  | Map (Array (Tuple a a))
 
 instance functorEJsonF ∷ Functor EJsonF where
   map f x =
@@ -43,7 +45,7 @@ instance functorEJsonF ∷ Functor EJsonF where
       Interval i → Interval i
       ObjectId oid → ObjectId oid
       Array xs → Array $ f <$> xs
-      Object xs → Object $ BF.bimap f f <$> xs
+      Map xs → Map $ BF.bimap f f <$> xs
 
 instance eq1EJsonF ∷ Eq1 EJsonF where
   eq1 Null Null = true
@@ -59,7 +61,7 @@ instance eq1EJsonF ∷ Eq1 EJsonF where
   eq1 (Interval a) (Interval b) = a == b
   eq1 (ObjectId a) (ObjectId b) = a == b
   eq1 (Array xs) (Array ys) = xs == ys
-  eq1 (Object xs) (Object ys) =
+  eq1 (Map xs) (Map ys) =
     let
       xs' = L.fromFoldable xs
       ys' = L.fromFoldable ys
@@ -73,8 +75,8 @@ instance eq1EJsonF ∷ Eq1 EJsonF where
 isSubobject
   ∷ ∀ a b
   . (Eq a, Eq b)
-  ⇒ L.List (T.Tuple a b)
-  → L.List (T.Tuple a b)
+  ⇒ L.List (Tuple a b)
+  → L.List (Tuple a b)
   → Boolean
 isSubobject xs ys =
   F.foldl
@@ -136,11 +138,19 @@ instance ord1EJsonF ∷ Ord1 EJsonF where
   compare1 _ (Array _) = GT
   compare1 (Array _) _ = LT
 
-  compare1 (Object a) (Object b) = compare (pairsToObject a) (pairsToObject b)
-
-pairsToObject
-  ∷ ∀ a b
-  . (Ord a)
-  ⇒ Array (T.Tuple a b)
-  → Map.Map a b
-pairsToObject = Map.fromFoldable
+  compare1 (Map a) (Map b) = compare (Map.fromFoldable a) (Map.fromFoldable b)
+
+getType ∷ ∀ a. EJsonF a → T.EJsonType
+getType = case _ of
+  Null → T.Null
+  String _ → T.String
+  Boolean _ → T.Boolean
+  Integer _ → T.Integer
+  Decimal _ → T.Decimal
+  Timestamp _ → T.Timestamp
+  Date _ → T.Date
+  Time _ → T.Time
+  Interval _ → T.Interval
+  ObjectId _ → T.ObjectId
+  Array _ → T.Array
+  Map _ → T.Map

src/Data/Json/Extended/Signature/Gen.purs

@@ -39,7 +39,7 @@ arbitraryEJsonFWithKeyGen keyGen rec =
   Gen.oneOf (pure Null)
     [ arbitraryBaseEJsonF
     , Array <$> Gen.arrayOf rec
-    , Object <$> do
+    , Map <$> do
         keys ← distinctArrayOf keyGen
         vals ← Gen.vectorOf (A.length keys) rec
         pure $ A.zip keys vals

src/Data/Json/Extended/Signature/Json.purs

@@ -36,7 +36,7 @@ encodeJsonEJsonF rec asKey x =
     Interval str → JS.jsonSingletonObject "$interval" $ encodeJson str
     ObjectId str → JS.jsonSingletonObject "$oid" $ encodeJson str
     Array xs → encodeJson $ rec <$> xs
-    Object xs → JS.jsonSingletonObject "$obj" $ encodeJson $ asStrMap xs
+    Map xs → JS.jsonSingletonObject "$obj" $ encodeJson $ asStrMap xs
       where
         tuple
           ∷ T.Tuple a a
@@ -137,7 +137,7 @@ decodeJsonEJsonF rec makeKey =
       ∷ SM.StrMap a
       → EJsonF a
     strMapObject =
-      Object
+      Map
         <<< A.fromFoldable
         <<< map (\(T.Tuple k v) → T.Tuple (makeKey k) v)
         <<< SM.toList

src/Data/Json/Extended/Signature/Parse.purs

@@ -258,7 +258,7 @@ parseEJsonF rec =
     , Interval <$> taggedLiteral "INTERVAL"
     , ObjectId <$> taggedLiteral "OID"
     , Array <<< A.fromFoldable <$> squares (commaSep rec)
-    , Object <<< A.fromFoldable <$> braces (commaSep parseAssignment)
+    , Map <<< A.fromFoldable <$> braces (commaSep parseAssignment)
     ]
 
   where

src/Data/Json/Extended/Signature/Render.purs

@@ -31,7 +31,7 @@ renderEJsonF rec d =
     Interval str → tagged "INTERVAL" str
     ObjectId str → tagged "OID" str
     Array ds → squares $ commaSep ds
-    Object ds → braces $ renderPairs ds
+    Map ds → braces $ renderPairs ds
   where
     tagged
       ∷ String

src/Data/Json/Extended/Type.purs

@@ -0,0 +1,34 @@
+module Data.Json.Extended.Type where
+
+import Prelude
+
+data EJsonType
+  = Null
+  | String
+  | Boolean
+  | Integer
+  | Decimal
+  | Timestamp
+  | Date
+  | Time
+  | Interval
+  | ObjectId
+  | Array
+  | Map
+
+derive instance eqEJsonType ∷ Eq EJsonType
+derive instance ordEJsonType ∷ Ord EJsonType
+
+instance showEJsonType ∷ Show EJsonType where
+  show Null = "Null"
+  show String = "String"
+  show Boolean = "Boolean"
+  show Integer = "Integer"
+  show Decimal = "Decimal"
+  show Timestamp = "Timestamp"
+  show Date = "Date"
+  show Time = "Time"
+  show Interval = "Interval"
+  show ObjectId = "ObjectId"
+  show Array = "Array"
+  show Map = "Map"