en- and decode YAML

.gitignore

@@ -0,0 +1,6 @@
+/bower_components/
+/node_modules/
+/output/
+/.psci*
+/src/.webpack.js
+.pulp-cache/

README.md

@@ -0,0 +1,125 @@
+# purescript-yaml
+
+```purescript
+data Point = Point Int Int
+
+data Mobility
+    = Fix
+    | Flex
+
+data GeoObject = GeoObject
+    { name :: String
+    , scale :: Number
+    , points :: Array Point
+    , mobility :: Mobility
+    , coverage :: Number
+    }
+```
+
+## Decode YAML
+
+Write `IsForeign` instances for your data structures.
+
+```purescript
+instance pointIsForeign :: IsForeign Point where
+    read value = do
+        x <- readProp "X" value
+        y <- readProp "Y" value
+        return $ Point x y
+
+instance mobilityIsForeign :: IsForeign Mobility where
+    read value = do
+        mob <- readString value
+        case mob of
+            "Fix" -> return Fix
+            "Flex" -> return Flex
+            _ -> Left $ JSONError "Mobility must be either Flex or Fix"
+
+instance archiObjectIsForeign :: IsForeign GeoObject where
+    read value = do
+        name <- readProp "Name"  value
+        scale <- readProp "Scale"  value
+        points <- readProp "Points"  value
+        mobility <- readProp "Mobility"  value
+        coverage <- readProp "Coverage"  value
+        return $ GeoObject { name, scale, points, mobility, coverage }
+```
+
+Read the YAML into your data structures.
+
+```purescript
+yamlInput :: String
+yamlInput = """
+- Name: House
+  Scale: 9.5
+  Points:
+  - X: 10
+    Y: 10
+  - X: 20
+    Y: 10
+  - X: 5
+    Y: 5
+  Mobility: Fix
+  Coverage: 10
+- Name: Tree
+  Scale: 1
+  Points:
+  - X: 1
+    Y: 1
+  - X: 2
+    Y: 2
+  - X: 0
+    Y: 0
+  Mobility: Fix
+  Coverage: 10
+"""
+
+decoded = (readYAML yamlInput) :: F (Array GeoObject)
+```
+
+## Encode YAML
+
+```purescript
+instance pointToYAML :: ToYAML Point where
+    toYAML (Point x y) =
+        object
+            [ "X" := x
+            , "Y" := y
+            ]
+
+instance mobilityToYAML :: ToYAML Mobility where
+    toYAML Fix = toYAML "Fix"
+    toYAML Flex = toYAML "Flex"
+
+instance archiObjectToYAML :: ToYAML GeoObject where
+    toYAML (GeoObject o) =
+        object
+            [ "Name" := o.name
+            , "Scale" := o.scale
+            , "Points" := o.points
+            , "Mobility" := o.mobility
+            , "Coverage" := o.coverage
+            ]
+```
+
+```purescript
+data :: Array GeoObject
+data =
+    [ GeoObject
+        { coverage: 10.0
+        , mobility: Fix
+        , name: "House"
+        , points: [ Point 10 10, Point 20 10, Point 5 5 ]
+        , scale: 9.5
+        }
+    , GeoObject
+        { coverage: 10.0
+        , mobility: Fix
+        , name: "Tree"
+        , points: [ Point 1 1, Point 2 2, Point 0 0 ]
+        , scale: 1.0
+        }
+    ]
+
+encoded = printYAML data
+```

bower.json

@@ -0,0 +1,25 @@
+{
+  "name": "purescript-yaml",
+  "version": "0.1.0",
+  "moduleType": [
+    "node"
+  ],
+  "ignore": [
+    "**/.*",
+    "node_modules",
+    "bower_components",
+    "output"
+  ],
+  "dependencies": {
+    "purescript-console": "^0.1.0",
+    "js-yaml": "~3.4.6",
+    "purescript-functions": "~0.1.0",
+    "purescript-foreign": "~0.7.2",
+    "purescript-generics": "~0.7.0",
+    "purescript-foreign-generic": "~0.3.0",
+    "purescript-unsafe-coerce": "~0.1.0"
+  },
+  "devDependencies": {
+    "purescript-spec": "~0.7.2"
+  }
+}

docs/Data/YAML/Foreign/Decode.md

@@ -0,0 +1,27 @@
+## Module Data.YAML.Foreign.Decode
+
+#### `parseYAML`
+
+``` purescript
+parseYAML :: String -> F Foreign
+```
+
+Attempt to parse a YAML string, returning the result as foreign data.
+
+#### `readYAML`
+
+``` purescript
+readYAML :: forall a. (IsForeign a) => String -> F a
+```
+
+Attempt to parse a YAML string into the datastructure you want.
+
+#### `readYAMLGeneric`
+
+``` purescript
+readYAMLGeneric :: forall a. (Generic a) => Options -> String -> F a
+```
+
+Automatically generate a YAML parser for your data from a generic instance.
+
+

docs/Data/YAML/Foreign/Encode.md

@@ -0,0 +1,115 @@
+## Module Data.YAML.Foreign.Encode
+
+#### `YObject`
+
+``` purescript
+type YObject = Map String YValue
+```
+
+#### `YArray`
+
+``` purescript
+type YArray = Array YValue
+```
+
+#### `YAML`
+
+``` purescript
+data YAML :: *
+```
+
+#### `YValue`
+
+``` purescript
+data YValue
+  = YObject YObject
+  | YArray YArray
+  | YString String
+  | YNumber Number
+  | YInt Int
+  | YBoolean Boolean
+  | YNull
+```
+
+##### Instances
+``` purescript
+Show YValue
+Eq YValue
+```
+
+#### `ToYAML`
+
+``` purescript
+class ToYAML a where
+  toYAML :: a -> YValue
+```
+
+##### Instances
+``` purescript
+ToYAML Boolean
+ToYAML Int
+ToYAML Number
+ToYAML String
+(ToYAML a) => ToYAML (Array a)
+(ToYAML a) => ToYAML (Maybe a)
+```
+
+#### `Pair`
+
+``` purescript
+type Pair = Tuple String YValue
+```
+
+#### `(:=)`
+
+``` purescript
+(:=) :: forall a. (ToYAML a) => String -> a -> Pair
+```
+
+_left-associative / precedence -1_
+
+Helper function to create a key-value tuple for a YAML object.
+
+`name = "Name" := "This is the name"`
+
+#### `object`
+
+``` purescript
+object :: Array Pair -> YValue
+```
+
+Helper function to create a YAML object.
+
+`obj = object [ "Name" := "This is the name", "Size" := 1.5 ]`
+
+#### `jsNull`
+
+``` purescript
+jsNull :: YAML
+```
+
+#### `objToHash`
+
+``` purescript
+objToHash :: Fn4 (YValue -> YAML) (Tuple String YValue -> String) (Tuple String YValue -> YValue) (Array (Tuple String YValue)) YAML
+```
+
+#### `valueToYAML`
+
+``` purescript
+valueToYAML :: YValue -> YAML
+```
+
+#### `toYAMLImpl`
+
+``` purescript
+toYAMLImpl :: YAML -> String
+```
+
+#### `printYAML`
+
+``` purescript
+printYAML :: forall a. (ToYAML a) => a -> String
+```
+
+

package.json

@@ -0,0 +1,17 @@
+{
+  "name": "purescript-yaml",
+  "license": "Apache 2.0",
+  "repository": "",
+  "private": true,
+  "contributors": [ ],
+  "main": "main.js",
+  "scripts": {
+    "postinstall": "bower install",
+    "build": "pulp build"
+  },
+  "devDependencies": {
+  },
+  "dependencies": {
+    "js-yaml": "^3.4.6"
+  }
+}

src/Data/YAML/Foreign/Decode.js

@@ -0,0 +1,17 @@
+"use strict";
+
+// module Data.YAML.Foreign.Decode
+
+var yaml = require('js-yaml');
+
+exports.parseYAMLImpl = function(left, right, str)
+    {
+        try
+        {
+            return right(yaml.safeLoad(str));
+        }
+        catch (e)
+        {
+            return left(e.toString());
+        }
+    };

src/Data/YAML/Foreign/Decode.purs

@@ -0,0 +1,24 @@
+module Data.YAML.Foreign.Decode (parseYAML, readYAML, readYAMLGeneric) where
+
+import Control.Bind ((>=>))
+import Data.Either
+import Data.Foreign (Foreign (), F (), ForeignError (..))
+import Data.Foreign.Class (IsForeign, read)
+import Data.Foreign.Generic
+import Data.Function (Fn3(), runFn3)
+import Data.Generic (Generic)
+import Prelude (Show, (<<<), (++), (>>=))
+
+foreign import parseYAMLImpl :: forall r. Fn3 (String -> r) (Foreign -> r) String r
+
+-- | Attempt to parse a YAML string, returning the result as foreign data.
+parseYAML :: String -> F Foreign
+parseYAML yaml = runFn3 parseYAMLImpl (Left <<< JSONError) Right yaml
+
+-- | Attempt to parse a YAML string into the datastructure you want.
+readYAML :: forall a. (IsForeign a) => String -> F a
+readYAML yaml = parseYAML yaml >>= read
+
+-- | Automatically generate a YAML parser for your data from a generic instance.
+readYAMLGeneric :: forall a. (Generic a) => Options -> String -> F a
+readYAMLGeneric opts = parseYAML >=> readGeneric opts

src/Data/YAML/Foreign/Encode.js

@@ -0,0 +1,23 @@
+"use strict";
+
+// module Data.YAML.Foreign.Encode
+
+var yaml = require('js-yaml');
+
+exports.jsNull = null;
+
+exports.objToHash =
+	function(valueToYAMLImpl, fst, snd, obj)
+	{
+	    var hash = {};
+	    for(var i = 0; i < obj.length; i++) {
+	        hash[fst(obj[i])] = valueToYAMLImpl(snd(obj[i]));
+	    }
+	    return hash;
+	};
+
+exports.toYAMLImpl =
+	function(a)
+	{
+		return yaml.safeDump(a);
+	}

src/Data/YAML/Foreign/Encode.purs

@@ -0,0 +1,98 @@
+module Data.YAML.Foreign.Encode where
+
+import Data.Function (Fn4(), runFn4)
+import Data.List (fromList, toList)
+import qualified Data.Map as M
+import Data.Maybe (Maybe (), maybe)
+import Data.Tuple (Tuple (..), fst, snd)
+import Prelude (Eq, Show, map, show, ($), (++), (==), (<<<))
+import Unsafe.Coerce (unsafeCoerce)
+
+type YObject = M.Map String YValue
+type YArray = Array YValue
+foreign import data YAML :: *
+
+data YValue
+    = YObject YObject
+    | YArray YArray
+    | YString String
+    | YNumber Number
+    | YInt Int
+    | YBoolean Boolean
+    | YNull
+
+instance showYValue :: Show YValue where
+    show (YObject m) = "YObject " ++ show m
+    show (YArray vs) = "YArray " ++ show vs
+    show (YString s) = "YString " ++ show s
+    show (YNumber n) = "YNumber " ++ show n
+    show (YInt i) = "YInt " ++ show i
+    show (YBoolean b) = "YBoolean " ++ show b
+    show YNull = "YNull"
+
+instance eqYValue :: Eq YValue where
+    eq (YObject a) (YObject b) = a == b
+    eq (YArray a) (YArray b) = a == b
+    eq (YString a) (YString b) = a == b
+    eq (YNumber a) (YNumber b) = a == b
+    eq (YInt a) (YInt b) = a == b
+    eq (YBoolean a) (YBoolean b) = a == b
+    eq YNull YNull = true
+    eq _ _ = false
+
+class ToYAML a where
+    toYAML :: a -> YValue
+
+instance booleanToYAML :: ToYAML Boolean where
+    toYAML = YBoolean
+
+instance intToYAML :: ToYAML Int where
+    toYAML = YInt
+
+instance numberToYAML :: ToYAML Number where
+    toYAML = YNumber
+
+instance stringToYAML :: ToYAML String where
+    toYAML = YString
+
+instance arrayToYAML :: (ToYAML a) => ToYAML (Array a) where
+    toYAML = YArray <<< map toYAML
+
+instance maybeToYAML :: (ToYAML a) => ToYAML (Maybe a) where
+    toYAML = maybe YNull toYAML
+
+type Pair = Tuple String YValue
+
+-- | Helper function to create a key-value tuple for a YAML object.
+-- |
+-- | `name = "Name" := "This is the name"`
+(:=) :: forall a. (ToYAML a) => String -> a -> Pair
+(:=) name value = Tuple name (toYAML value)
+
+-- | Helper function to create a YAML object.
+-- |
+-- | `obj = object [ "Name" := "This is the name", "Size" := 1.5 ]`
+object :: Array Pair -> YValue
+object ps = YObject $ M.fromList $ toList $ ps
+
+foreign import jsNull :: YAML
+foreign import objToHash ::
+    Fn4 (YValue -> YAML)
+        (Tuple String YValue -> String)
+        (Tuple String YValue -> YValue)
+        (Array (Tuple String YValue))
+        YAML
+
+valueToYAML :: YValue -> YAML
+valueToYAML (YObject o) = runFn4 objToHash valueToYAML fst snd $ fromList $ M.toList o
+valueToYAML (YArray a) = unsafeCoerce $ map valueToYAML a
+valueToYAML (YString s) = unsafeCoerce s
+valueToYAML (YNumber n) = unsafeCoerce n
+valueToYAML (YInt i) = unsafeCoerce i
+valueToYAML (YBoolean b) = unsafeCoerce b
+valueToYAML YNull = jsNull
+
+foreign import toYAMLImpl :: YAML -> String
+
+printYAML :: forall a. (ToYAML a) => a -> String
+printYAML = toYAMLImpl <<< valueToYAML <<< toYAML

test/Instances.purs

@@ -0,0 +1,79 @@
+module Test.Instances where
+
+import Prelude
+import Data.Either
+import Data.Foreign
+import Data.Foreign.Class
+import Data.Generic (Generic, gShow, gEq)
+
+import Data.YAML.Foreign.Encode
+
+data Point = Point Int Int
+
+data Mobility
+    = Fix
+    | Flex
+
+data GeoObject = GeoObject
+    { name :: String
+    , scale :: Number
+    , points :: Array Point
+    , mobility :: Mobility
+    , coverage :: Number
+    }
+
+derive instance genericGeoObject :: Generic GeoObject
+instance showGeoObject :: Show GeoObject where show = gShow
+instance eqGeoObject :: Eq GeoObject where eq = gEq
+
+derive instance genericPoint :: Generic Point
+instance showPoint :: Show Point where show = gShow
+instance eqPoint :: Eq Point where eq = gEq
+
+derive instance genericMobility :: Generic Mobility
+instance showMobility :: Show Mobility where show = gShow
+instance eqMobility :: Eq Mobility where eq = gEq
+
+instance archiObjectIsForeign :: IsForeign GeoObject where
+    read value = do
+        name <- readProp "Name"  value
+        scale <- readProp "Scale"  value
+        points <- readProp "Points"  value
+        mobility <- readProp "Mobility"  value
+        coverage <- readProp "Coverage"  value
+        return $ GeoObject { name, scale, points, mobility, coverage }
+
+instance pointIsForeign :: IsForeign Point where
+    read value = do
+        x <- readProp "X" value
+        y <- readProp "Y" value
+        return $ Point x y
+
+instance mobilityIsForeign :: IsForeign Mobility where
+    read value = do
+        mob <- readString value
+        case mob of
+            "Fix" -> return Fix
+            "Flex" -> return Flex
+            _ -> Left $ JSONError "Mobility must be either Flex or Fix"
+
+instance pointToYAML :: ToYAML Point where
+    toYAML (Point x y) =
+        object
+            [ "X" := x
+            , "Y" := y
+            ]
+
+instance mobilityToYAML :: ToYAML Mobility where
+    toYAML Fix = toYAML "Fix"
+    toYAML Flex = toYAML "Flex"
+
+instance archiObjectToYAML :: ToYAML GeoObject where
+    toYAML (GeoObject o) =
+        object
+            [ "Name" := o.name
+            , "Scale" := o.scale
+            , "Points" := o.points
+            , "Mobility" := o.mobility
+            , "Coverage" := o.coverage
+            ]

test/Main.purs

@@ -0,0 +1,98 @@
+module Test.Main where
+
+import Prelude
+
+import Data.Either
+import Data.Foreign
+import Control.Monad.Eff
+import Control.Monad.Eff.Console (CONSOLE ())
+import Test.Spec (describe, it)
+import Test.Spec.Runner (Process (), run)
+import Test.Spec.Assertions (shouldEqual)
+import Test.Spec.Reporter.Console (consoleReporter)
+
+import Data.YAML.Foreign.Decode
+import Data.YAML.Foreign.Encode
+import Test.Instances
+
+yamlInput :: String
+yamlInput = """
+- Name: House
+  Scale: 9.5
+  # Points describe the outer limit of an object.
+  Points:
+  - X: 10
+    Y: 10
+  - X: 20
+    Y: 10
+  - X: 5
+    Y: 5
+  Mobility: Fix
+  Coverage: 10
+- Name: Tree
+  Scale: 1
+  Points:
+  - X: 1
+    Y: 1
+  - X: 2
+    Y: 2
+  - X: 0
+    Y: 0
+  Mobility: Fix
+  Coverage: 10
+"""
+
+yamlOutput :: String
+yamlOutput = """- Coverage: 10
+  Mobility: Fix
+  Name: House
+  Points:
+    - X: 10
+      'Y': 10
+    - X: 20
+      'Y': 10
+    - X: 5
+      'Y': 5
+  Scale: 9.5
+- Coverage: 10
+  Mobility: Fix
+  Name: Tree
+  Points:
+    - X: 1
+      'Y': 1
+    - X: 2
+      'Y': 2
+    - X: 0
+      'Y': 0
+  Scale: 1
+"""
+
+parsedData :: Array GeoObject
+parsedData =
+    [ GeoObject
+        { coverage: 10.0
+        , mobility: Fix
+        , name: "House"
+        , points: [ Point 10 10, Point 20 10, Point 5 5 ]
+        , scale: 9.5
+        }
+    , GeoObject
+        { coverage: 10.0
+        , mobility: Fix
+        , name: "Tree"
+        , points: [ Point 1 1, Point 2 2, Point 0 0 ]
+        , scale: 1.0
+        }
+    ]
+
+main :: Eff (console :: CONSOLE, process :: Process) Unit
+main = run [consoleReporter] do
+  describe "purescript-yaml" do
+    describe "decode" do
+      it "Decodes YAML" do
+        let decoded = (readYAML yamlInput) :: F (Array GeoObject)
+        decoded `shouldEqual` (Right parsedData)
+    describe "encode" do
+      it "Encodes YAML" $ do
+        let encoded = printYAML parsedData
+        encoded `shouldEqual` yamlOutput