thunderstrike/purescript-yaml
thunderstrike/purescript-yaml
2
0
Fork 0
generated from tpl/purs
Code Issues Pull Requests Packages Projects Releases Wiki Activity

chore: fmt

Browse Source
This commit is contained in:
orion kindel 2023-11-28 14:25:43 -06:00
parent 30b219d237
commit 00fb682314
Signed by: orion
GPG Key ID: 6D4165AE4C928719
6 changed files with 122 additions and 116 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
src/Data/YAML/Foreign/Decode.js
View File

@ -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())
}
}

10
src/Data/YAML/Foreign/Decode.purs
View File

@ -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 =

10
src/Data/YAML/Foreign/Encode.js
View File

@ -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 })
}

90
src/Data/YAML/Foreign/Encode.purs
View File

@ -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

75
test/Instances.purs
View File

@ -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
]

48
test/Main.purs
View File

@ -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