From 3815338f53e9d2aff7499d3d1810c60bb2c62b17 Mon Sep 17 00:00:00 2001 From: Nicolas Gagliani Date: Sun, 20 Dec 2015 15:35:04 +0100 Subject: [PATCH] en- and decode YAML --- .gitignore | 6 ++ README.md | 125 ++++++++++++++++++++++++++++++ bower.json | 25 ++++++ docs/Data/YAML/Foreign/Decode.md | 27 +++++++ docs/Data/YAML/Foreign/Encode.md | 115 +++++++++++++++++++++++++++ package.json | 17 ++++ src/Data/YAML/Foreign/Decode.js | 17 ++++ src/Data/YAML/Foreign/Decode.purs | 24 ++++++ src/Data/YAML/Foreign/Encode.js | 23 ++++++ src/Data/YAML/Foreign/Encode.purs | 98 +++++++++++++++++++++++ test/Instances.purs | 79 +++++++++++++++++++ test/Main.purs | 98 +++++++++++++++++++++++ 12 files changed, 654 insertions(+) create mode 100644 .gitignore create mode 100644 README.md create mode 100644 bower.json create mode 100644 docs/Data/YAML/Foreign/Decode.md create mode 100644 docs/Data/YAML/Foreign/Encode.md create mode 100644 package.json create mode 100644 src/Data/YAML/Foreign/Decode.js create mode 100644 src/Data/YAML/Foreign/Decode.purs create mode 100644 src/Data/YAML/Foreign/Encode.js create mode 100644 src/Data/YAML/Foreign/Encode.purs create mode 100644 test/Instances.purs create mode 100644 test/Main.purs diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..87be35f --- /dev/null +++ b/.gitignore @@ -0,0 +1,6 @@ +/bower_components/ +/node_modules/ +/output/ +/.psci* +/src/.webpack.js +.pulp-cache/ diff --git a/README.md b/README.md new file mode 100644 index 0000000..f1469f6 --- /dev/null +++ b/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 +``` diff --git a/bower.json b/bower.json new file mode 100644 index 0000000..6575c2c --- /dev/null +++ b/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" + } +} diff --git a/docs/Data/YAML/Foreign/Decode.md b/docs/Data/YAML/Foreign/Decode.md new file mode 100644 index 0000000..358bd32 --- /dev/null +++ b/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. + + diff --git a/docs/Data/YAML/Foreign/Encode.md b/docs/Data/YAML/Foreign/Encode.md new file mode 100644 index 0000000..27db657 --- /dev/null +++ b/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 +``` + + diff --git a/package.json b/package.json new file mode 100644 index 0000000..08e3466 --- /dev/null +++ b/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" + } +} diff --git a/src/Data/YAML/Foreign/Decode.js b/src/Data/YAML/Foreign/Decode.js new file mode 100644 index 0000000..508a030 --- /dev/null +++ b/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()); + } + }; diff --git a/src/Data/YAML/Foreign/Decode.purs b/src/Data/YAML/Foreign/Decode.purs new file mode 100644 index 0000000..0102a62 --- /dev/null +++ b/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 diff --git a/src/Data/YAML/Foreign/Encode.js b/src/Data/YAML/Foreign/Encode.js new file mode 100644 index 0000000..ff09d26 --- /dev/null +++ b/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); + } diff --git a/src/Data/YAML/Foreign/Encode.purs b/src/Data/YAML/Foreign/Encode.purs new file mode 100644 index 0000000..6ff3970 --- /dev/null +++ b/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 diff --git a/test/Instances.purs b/test/Instances.purs new file mode 100644 index 0000000..9245913 --- /dev/null +++ b/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 + ] diff --git a/test/Main.purs b/test/Main.purs new file mode 100644 index 0000000..c7fc275 --- /dev/null +++ b/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