diff --git a/src/Data/YAML/Foreign/Decode.js b/src/Data/YAML/Foreign/Decode.js index 40e64a4..0ca2dfd 100644 --- a/src/Data/YAML/Foreign/Decode.js +++ b/src/Data/YAML/Foreign/Decode.js @@ -1,10 +1,9 @@ import yaml from 'js-yaml' -export function parseYAMLImpl (left, right, str) { +export function parseYAMLImpl(left, right, str) { try { return right(yaml.load(str)) - } - catch (e) { + } catch (e) { return left(e.toString()) } } diff --git a/src/Data/YAML/Foreign/Decode.purs b/src/Data/YAML/Foreign/Decode.purs index fa12d7f..baa00be 100644 --- a/src/Data/YAML/Foreign/Decode.purs +++ b/src/Data/YAML/Foreign/Decode.purs @@ -1,5 +1,4 @@ -module Data.YAML.Foreign.Decode (parseYAMLToJson) -where +module Data.YAML.Foreign.Decode (parseYAMLToJson) where import Foreign (F, Foreign, ForeignError(..), fail) import Data.Function.Uncurried (Fn3, runFn3) @@ -7,16 +6,15 @@ import Prelude (pure, (<<<), (>>=)) import Unsafe.Coerce (unsafeCoerce) import Data.Argonaut.Core (Json) -foreign import parseYAMLImpl :: forall r. - Fn3 (String -> r) (Foreign -> r) String r - +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 (fail <<< ForeignError) pure yaml - -- | Attempt to parse a YAML string, returning the result as Json parseYAMLToJson :: String -> F Json parseYAMLToJson yaml = diff --git a/src/Data/YAML/Foreign/Encode.js b/src/Data/YAML/Foreign/Encode.js index 163b2d4..b4bcd92 100644 --- a/src/Data/YAML/Foreign/Encode.js +++ b/src/Data/YAML/Foreign/Encode.js @@ -2,17 +2,17 @@ import yaml from 'js-yaml' export const jsNull = null -export function objToHash (valueToYAMLImpl, fst, snd, obj) { +export function objToHash(valueToYAMLImpl, fst, snd, obj) { const hash = {} - for(let i = 0; i < obj.length; i++) { + for (let i = 0; i < obj.length; i++) { hash[fst(obj[i])] = valueToYAMLImpl(snd(obj[i])) } return hash } -export function toYAMLImpl (a) { - // noCompatMode does not support YAML 1.1 - return yaml.dump(a, {noCompatMode : true}) +export function toYAMLImpl(a) { + // noCompatMode does not support YAML 1.1 + return yaml.dump(a, { noCompatMode: true }) } diff --git a/src/Data/YAML/Foreign/Encode.purs b/src/Data/YAML/Foreign/Encode.purs index 6848527..c2f7528 100644 --- a/src/Data/YAML/Foreign/Encode.purs +++ b/src/Data/YAML/Foreign/Encode.purs @@ -1,10 +1,11 @@ -module Data.YAML.Foreign.Encode ( - YValue, - class ToYAML, - toYAML, - entry, (:=), - object, - printYAML +module Data.YAML.Foreign.Encode + ( YValue + , class ToYAML + , toYAML + , entry + , (:=) + , object + , printYAML ) where import Data.Map as M @@ -19,62 +20,63 @@ import Unsafe.Coerce (unsafeCoerce) type YObject = M.Map String YValue type YArray = Array YValue + foreign import data YAML :: Type data YValue - = YObject YObject - | YArray YArray - | YString String - | YNumber Number - | YInt Int - | YBoolean Boolean - | YNull + = 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" + 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 + 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 + toYAML :: a -> YValue instance mapToYAML :: (ToYAML a) => ToYAML (Map String a) where - toYAML m = YObject $ map (\value -> toYAML value) m + toYAML m = YObject $ map (\value -> toYAML value) m instance booleanToYAML :: ToYAML Boolean where - toYAML = YBoolean + toYAML = YBoolean instance intToYAML :: ToYAML Int where - toYAML = YInt + toYAML = YInt instance numberToYAML :: ToYAML Number where - toYAML = YNumber + toYAML = YNumber instance stringToYAML :: ToYAML String where - toYAML = YString + toYAML = YString instance arrayToYAML :: (ToYAML a) => ToYAML (Array a) where - toYAML = YArray <<< map toYAML + toYAML = YArray <<< map toYAML instance maybeToYAML :: (ToYAML a) => ToYAML (Maybe a) where - toYAML = maybe YNull toYAML + toYAML = maybe YNull toYAML instance yvalueToYAML :: ToYAML YValue where - toYAML = identity + toYAML = identity type Pair = Tuple String YValue @@ -93,12 +95,12 @@ object :: Array Pair -> YValue object ps = YObject $ M.fromFoldable (toUnfoldable ps :: List Pair) foreign import jsNull :: YAML -foreign import objToHash :: - Fn4 (YValue -> YAML) - (Tuple String YValue -> String) - (Tuple String YValue -> YValue) - (Array (Tuple String YValue)) - 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 $ M.toUnfoldable o diff --git a/test/Instances.purs b/test/Instances.purs index 79c1ea2..bbec373 100644 --- a/test/Instances.purs +++ b/test/Instances.purs @@ -14,28 +14,37 @@ import Prelude (class Eq, class Show, bind, pure, ($)) data Point = Point Int Int data Mobility - = Fix - | Flex + = Fix + | Flex data GeoObject = GeoObject - { name :: String - , scale :: Number - , points :: Array Point - , mobility :: Mobility - , coverage :: Number - } + { name :: String + , scale :: Number + , points :: Array Point + , mobility :: Mobility + , coverage :: Number + } derive instance genericGeoObject :: Generic GeoObject _ -instance showGeoObject :: Show GeoObject where show = genericShow -instance eqGeoObject :: Eq GeoObject where eq = genericEq +instance showGeoObject :: Show GeoObject where + show = genericShow + +instance eqGeoObject :: Eq GeoObject where + eq = genericEq derive instance genericPoint :: Generic Point _ -instance showPoint :: Show Point where show = genericShow -instance eqPoint :: Eq Point where eq = genericEq +instance showPoint :: Show Point where + show = genericShow + +instance eqPoint :: Eq Point where + eq = genericEq derive instance genericMobility :: Generic Mobility _ -instance showMobility :: Show Mobility where show = genericShow -instance eqMobility :: Eq Mobility where eq = genericEq +instance showMobility :: Show Mobility where + show = genericShow + +instance eqMobility :: Eq Mobility where + eq = genericEq instance geoJson :: DecodeJson GeoObject where decodeJson json = do @@ -51,10 +60,9 @@ instance mobilityJson :: DecodeJson Mobility where decodeJson json = do mob <- decodeJson json case mob of - "Fix" -> pure Fix - "Flex" -> pure Flex - _ -> Left $ TypeMismatch "Mobility must be either Flex or Fix" - + "Fix" -> pure Fix + "Flex" -> pure Flex + _ -> Left $ TypeMismatch "Mobility must be either Flex or Fix" instance pointJson :: DecodeJson Point where decodeJson json = do @@ -63,24 +71,23 @@ instance pointJson :: DecodeJson Point where y <- getField obj "Y" pure $ Point x y - instance pointToYAML :: ToYAML Point where - toYAML (Point x y) = - object - [ "X" := x - , "Y" := y - ] + toYAML (Point x y) = + object + [ "X" := x + , "Y" := y + ] instance mobilityToYAML :: ToYAML Mobility where - toYAML Fix = toYAML "Fix" - toYAML Flex = toYAML "Flex" + 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 - ] + 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 index 599be83..1b10e1a 100644 --- a/test/Main.purs +++ b/test/Main.purs @@ -17,9 +17,9 @@ import Test.Spec.Assertions (shouldEqual) import Test.Spec.Reporter.Console (consoleReporter) import Test.Spec.Runner (runSpec) - yamlInput :: String -yamlInput = """ +yamlInput = + """ - Name: House Scale: 9.5 # Points describe the outer limit of an object. @@ -46,7 +46,8 @@ yamlInput = """ """ yamlOutput :: String -yamlOutput = """- Coverage: 10 +yamlOutput = + """- Coverage: 10 Mobility: Fix Name: House Points: @@ -70,9 +71,9 @@ yamlOutput = """- Coverage: 10 Scale: 1 """ - yamlMapOutput :: String -yamlMapOutput = """key: +yamlMapOutput = + """key: - Coverage: 10 Mobility: Fix Name: House @@ -98,7 +99,8 @@ yamlMapOutput = """key: """ pointYaml :: String -pointYaml = """X: 1 +pointYaml = + """X: 1 Y: 1 """ @@ -109,28 +111,26 @@ yamlToData s = case runExcept $ parseYAMLToJson s of Left error -> Left $ printJsonDecodeError error Right value -> Right value - testMap :: Map String (Array GeoObject) testMap = Map.singleton "key" parsedData - 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 - } - ] + [ 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 + } + ] readPoint :: String -> Either String Point readPoint = yamlToData @@ -139,7 +139,7 @@ fullCircle :: String -> Either String String fullCircle yamlString = (readPoint yamlString) >>= pure <<< printYAML main :: Effect Unit -main = launchAff_ $ runSpec [consoleReporter] do +main = launchAff_ $ runSpec [ consoleReporter ] do describe "purescript-yaml" do describe "decode" do it "Decodes YAML" do