generated from tpl/purs
chore: fmt
This commit is contained in:
parent
30b219d237
commit
00fb682314
@ -3,8 +3,7 @@ import yaml from 'js-yaml'
|
||||
export function parseYAMLImpl(left, right, str) {
|
||||
try {
|
||||
return right(yaml.load(str))
|
||||
}
|
||||
catch (e) {
|
||||
} catch (e) {
|
||||
return left(e.toString())
|
||||
}
|
||||
}
|
||||
|
@ -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 =
|
||||
|
@ -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,6 +20,7 @@ import Unsafe.Coerce (unsafeCoerce)
|
||||
|
||||
type YObject = M.Map String YValue
|
||||
type YArray = Array YValue
|
||||
|
||||
foreign import data YAML :: Type
|
||||
|
||||
data YValue
|
||||
@ -93,8 +95,8 @@ object :: Array Pair -> YValue
|
||||
object ps = YObject $ M.fromFoldable (toUnfoldable ps :: List Pair)
|
||||
|
||||
foreign import jsNull :: YAML
|
||||
foreign import objToHash ::
|
||||
Fn4 (YValue -> YAML)
|
||||
foreign import objToHash
|
||||
:: Fn4 (YValue -> YAML)
|
||||
(Tuple String YValue -> String)
|
||||
(Tuple String YValue -> YValue)
|
||||
(Array (Tuple String YValue))
|
||||
|
@ -26,16 +26,25 @@ data GeoObject = GeoObject
|
||||
}
|
||||
|
||||
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
|
||||
@ -55,7 +64,6 @@ instance mobilityJson :: DecodeJson Mobility where
|
||||
"Flex" -> pure Flex
|
||||
_ -> Left $ TypeMismatch "Mobility must be either Flex or Fix"
|
||||
|
||||
|
||||
instance pointJson :: DecodeJson Point where
|
||||
decodeJson json = do
|
||||
obj <- decodeJson json
|
||||
@ -63,7 +71,6 @@ instance pointJson :: DecodeJson Point where
|
||||
y <- getField obj "Y"
|
||||
pure $ Point x y
|
||||
|
||||
|
||||
instance pointToYAML :: ToYAML Point where
|
||||
toYAML (Point x y) =
|
||||
object
|
||||
|
@ -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,11 +111,9 @@ 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
|
||||
|
Loading…
Reference in New Issue
Block a user