Merge pull request #42 from puffnfresh/feature/asforeign

Add a class to create Foreign types

Author: garyb

examples/JSONSimpleTypes.purs

@@ -3,10 +3,10 @@ module Example.JSONSimpleTypes where
 import Prelude
 
 import Control.Monad.Eff (Eff)
-import Control.Monad.Eff.Console (CONSOLE, logShow)
+import Control.Monad.Eff.Console (CONSOLE, log, logShow)
 
-import Data.Foreign (F)
-import Data.Foreign.Class (readJSON)
+import Data.Foreign (F, unsafeFromForeign)
+import Data.Foreign.Class (readJSON, write)
 
 -- Parsing of the simple JSON String, Number and Boolean types is provided
 -- out of the box.
@@ -15,3 +15,6 @@ main = do
   logShow $ readJSON "\"a JSON string\"" :: F String
   logShow $ readJSON "42" :: F Number
   logShow $ readJSON "true" :: F Boolean
+  log $ unsafeFromForeign $ write "a JSON string"
+  log $ unsafeFromForeign $ write 42.0
+  log $ unsafeFromForeign $ write true

examples/MaybeNullable.purs

@@ -3,15 +3,18 @@ module Example.MaybeNullable where
 import Prelude
 
 import Control.Monad.Eff (Eff)
-import Control.Monad.Eff.Console (CONSOLE, logShow)
+import Control.Monad.Eff.Console (CONSOLE, log, logShow)
 
-import Data.Foreign (F)
-import Data.Foreign.Class (readJSON)
-import Data.Foreign.Null (Null, unNull)
+import Data.Foreign (F, unsafeFromForeign)
+import Data.Foreign.Class (readJSON, write)
+import Data.Foreign.Null (Null(..), unNull)
+import Data.Maybe (Maybe(..))
 
 -- Parsing values that are allowed to null or undefined is possible by
 -- using Maybe types.
 main :: Eff (console :: CONSOLE) Unit
 main = do
   logShow $ unNull <$> readJSON "null" :: F (Null Boolean)
   logShow $ unNull <$> readJSON "true" :: F (Null Boolean)
+  log $ unsafeFromForeign $ write $ Null Nothing :: Null Boolean
+  log $ unsafeFromForeign $ write $ Null $ Just true

examples/Objects.purs

@@ -3,10 +3,10 @@ module Example.Objects where
 import Prelude
 
 import Control.Monad.Eff (Eff)
-import Control.Monad.Eff.Console (CONSOLE, logShow)
+import Control.Monad.Eff.Console (CONSOLE, log, logShow)
 
-import Data.Foreign (F)
-import Data.Foreign.Class (class IsForeign, readJSON, readProp)
+import Data.Foreign (F, writeObject, unsafeFromForeign)
+import Data.Foreign.Class (class AsForeign, class IsForeign, (.=), readJSON, readProp, write)
 
 -- | To parse objects of a particular type, we need to define some helper
 --   data types as making class instances for records is not possible.
@@ -15,6 +15,11 @@ data Point = Point { x :: Number, y :: Number }
 instance showPoint :: Show Point where
   show (Point o) = "(Point { x: " <> show o.x <> ", y: " <> show o.y <> " })"
 
+instance pointAsForeign :: AsForeign Point where
+  write (Point o) = writeObject [ "x" .= o.x
+                                , "y" .= o.y
+                                ]
+
 -- | The IsForeign implementations for these types are basically boilerplate,
 --   type inference takes care of most of the work so we don't have to
 --   explicitly define the type each of the properties we're parsing.
@@ -27,3 +32,4 @@ instance pointIsForeign :: IsForeign Point where
 main :: Eff (console :: CONSOLE) Unit
 main = do
   logShow $ readJSON """{ "x": 1, "y": 2 }""" :: F Point
+  log $ unsafeFromForeign $ write $ Point { x: 1.0, y: 2.0 }

src/Data/Foreign.js

@@ -40,3 +40,11 @@ exports.isUndefined = function (value) {
 exports.isArray = Array.isArray || function (value) {
   return Object.prototype.toString.call(value) === "[object Array]";
 };
+
+exports.writeObject = function (fields) {
+  var record = {};
+  for (var i = 0; i < fields.length; i++) {
+    record[fields[i].key] = fields[i].value;
+  }
+  return record;
+};

src/Data/Foreign.purs

@@ -4,6 +4,7 @@
 module Data.Foreign
   ( Foreign()
   , ForeignError(..)
+  , Prop(..)
   , F()
   , parseJSON
   , toForeign
@@ -20,6 +21,7 @@ module Data.Foreign
   , readNumber
   , readInt
   , readArray
+  , writeObject
   ) where
 
 import Prelude
@@ -137,3 +139,7 @@ readInt value = either (const error) fromNumber (readNumber value)
 readArray :: Foreign -> F (Array Foreign)
 readArray value | isArray value = pure $ unsafeFromForeign value
 readArray value = Left (TypeMismatch "array" (tagOf value))
+
+newtype Prop = Prop { key :: String, value :: Foreign }
+
+foreign import writeObject :: Array Prop -> Foreign

src/Data/Foreign/Class.purs

@@ -2,22 +2,27 @@
 
 module Data.Foreign.Class
   ( class IsForeign
+  , class AsForeign
+  , (.=)
   , read
   , readJSON
   , readWith
   , readProp
+  , write
+  , writeProp
   ) where
 
 import Prelude
 
 import Data.Array (range, zipWith, length)
 import Data.Either (Either(..), either)
-import Data.Foreign (F, Foreign, ForeignError(..), parseJSON, readArray, readInt, readNumber, readBoolean, readChar, readString)
+import Data.Foreign (F, Foreign, ForeignError(..), Prop(..), parseJSON, readArray, readInt, readNumber, readBoolean, readChar, readString, toForeign)
 import Data.Foreign.Index (class Index, errorAt, (!))
-import Data.Foreign.Null (Null, readNull)
-import Data.Foreign.NullOrUndefined (NullOrUndefined, readNullOrUndefined)
-import Data.Foreign.Undefined (Undefined, readUndefined)
+import Data.Foreign.Null (Null(..), readNull, writeNull)
+import Data.Foreign.NullOrUndefined (NullOrUndefined(..), readNullOrUndefined)
+import Data.Foreign.Undefined (Undefined(..), readUndefined, writeUndefined)
 import Data.Traversable (sequence)
+import Data.Maybe (maybe)
 
 -- | A type class instance for this class can be written for a type if it
 -- | is possible to attempt to _safely_ coerce a `Foreign` value to that
@@ -75,3 +80,44 @@ readWith f value = either (Left <<< f) Right (read value)
 -- | Attempt to read a property of a foreign value at the specified index
 readProp :: forall a i. (IsForeign a, Index i) => i -> Foreign -> F a
 readProp prop value = value ! prop >>= readWith (errorAt prop)
+
+-- | A type class to convert to a `Foreign` value.
+-- |
+-- | Instances are provided for standard data structures.
+class AsForeign a where
+  write :: a -> Foreign
+
+instance foreignAsForeign :: AsForeign Foreign where
+  write = id
+
+instance stringAsForeign :: AsForeign String where
+  write = toForeign
+
+instance charAsForeign :: AsForeign Char where
+  write = toForeign
+
+instance booleanAsForeign :: AsForeign Boolean where
+  write = toForeign
+
+instance numberAsForeign :: AsForeign Number where
+  write = toForeign
+
+instance intAsForeign :: AsForeign Int where
+  write = toForeign
+
+instance arrayAsForeign :: (AsForeign a) => AsForeign (Array a) where
+  write = toForeign <<< map write
+
+instance nullAsForeign :: (AsForeign a) => AsForeign (Null a) where
+  write (Null a) = maybe writeNull write a
+
+instance undefinedAsForeign :: (AsForeign a) => AsForeign (Undefined a) where
+  write (Undefined a) = maybe writeUndefined write a
+
+instance nullOrUndefinedAsForeign :: (AsForeign a) => AsForeign (NullOrUndefined a) where
+  write (NullOrUndefined a) = write (Null a)
+
+infixl 8 writeProp as .=
+
+writeProp :: forall a. (AsForeign a) => String -> a -> Prop
+writeProp k v = Prop { key: k, value: write v }

src/Data/Foreign/Null.js

@@ -0,0 +1,6 @@
+/* global exports */
+"use strict";
+
+// module Data.Foreign.Null
+
+exports.writeNull = null;

src/Data/Foreign/Null.purs

@@ -20,3 +20,5 @@ unNull (Null m) = m
 readNull :: forall a. (Foreign -> F a) -> Foreign -> F (Null a)
 readNull _ value | isNull value = pure (Null Nothing)
 readNull f value = Null <<< Just <$> f value
+
+foreign import writeNull :: Foreign

src/Data/Foreign/Undefined.js

@@ -0,0 +1,6 @@
+/* global exports */
+"use strict";
+
+// module Data.Foreign.Undefined
+
+exports.writeUndefined = undefined;

src/Data/Foreign/Undefined.purs

@@ -20,3 +20,5 @@ unUndefined (Undefined m) = m
 readUndefined :: forall a. (Foreign -> F a) -> Foreign -> F (Undefined a)
 readUndefined _ value | isUndefined value = pure (Undefined Nothing)
 readUndefined f value = Undefined <<< Just <$> f value
+
+foreign import writeUndefined :: Foreign