generated from tpl/purs
Migrate for purescript 0.11
This commit is contained in:
parent
72bfaf2046
commit
fecfce4880
13
bower.json
13
bower.json
@ -12,14 +12,13 @@
|
||||
],
|
||||
"dependencies": {
|
||||
"js-yaml": "^3.4.6",
|
||||
"purescript-functions": "^2.0.0",
|
||||
"purescript-foreign": "^3.2.0",
|
||||
"purescript-foreign-generic": "^3.0.0",
|
||||
"purescript-unsafe-coerce": "^2.0.0"
|
||||
"purescript-functions": "^3.0.0",
|
||||
"purescript-foreign": "^4.0.0",
|
||||
"purescript-foreign-generic": "^4.1.0",
|
||||
"purescript-unsafe-coerce": "^3.0.0"
|
||||
},
|
||||
"devDependencies": {
|
||||
"purescript-console": "^2.0.0",
|
||||
"purescript-spec": "~0.12.1"
|
||||
"purescript-console": "^3.0.0",
|
||||
"purescript-spec": "^1.0.0"
|
||||
}
|
||||
}
|
||||
|
||||
|
@ -1,13 +1,12 @@
|
||||
module Data.YAML.Foreign.Decode (parseYAML, readYAML, readYAMLGeneric) where
|
||||
module Data.YAML.Foreign.Decode (parseYAML, readYAMLGeneric) where
|
||||
|
||||
import Data.Foreign (F, Foreign, ForeignError(..), fail)
|
||||
import Data.Foreign.Class (class IsForeign, read)
|
||||
import Data.Foreign.Generic (readGeneric)
|
||||
import Data.Foreign.Generic.Classes (class GenericDecode)
|
||||
import Data.Foreign.Generic.Class (class GenericDecode)
|
||||
import Data.Foreign.Generic (genericDecode)
|
||||
import Data.Foreign.Generic.Types (Options)
|
||||
import Data.Function.Uncurried (Fn3, runFn3)
|
||||
import Data.Generic.Rep (class Generic)
|
||||
import Prelude (pure, (<<<), (>>=), (>=>))
|
||||
import Prelude ((>=>), (<<<), pure)
|
||||
|
||||
foreign import parseYAMLImpl :: forall r. Fn3 (String -> r) (Foreign -> r) String r
|
||||
|
||||
@ -15,11 +14,6 @@ foreign import parseYAMLImpl :: forall r. Fn3 (String -> r) (Foreign -> r) Strin
|
||||
parseYAML :: String -> F Foreign
|
||||
parseYAML yaml = runFn3 parseYAMLImpl (fail <<< JSONError) pure 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 rep. (Generic a rep, GenericDecode rep) => Options -> String -> F a
|
||||
readYAMLGeneric opts = parseYAML >=> readGeneric opts
|
||||
|
||||
readYAMLGeneric :: forall a rep. (Generic a rep) => (GenericDecode rep) => Options -> String -> F a
|
||||
readYAMLGeneric opts = parseYAML >=> genericDecode opts
|
||||
|
@ -1,7 +1,7 @@
|
||||
module Data.YAML.Foreign.Encode where
|
||||
|
||||
import Data.Map as M
|
||||
import Data.Array (fromFoldable, toUnfoldable)
|
||||
import Data.Array (toUnfoldable)
|
||||
import Data.Function.Uncurried (Fn4, runFn4)
|
||||
import Data.List (List)
|
||||
import Data.Maybe (Maybe, maybe)
|
||||
@ -11,7 +11,7 @@ import Unsafe.Coerce (unsafeCoerce)
|
||||
|
||||
type YObject = M.Map String YValue
|
||||
type YArray = Array YValue
|
||||
foreign import data YAML :: *
|
||||
foreign import data YAML :: Type
|
||||
|
||||
data YValue
|
||||
= YObject YObject
|
||||
@ -87,7 +87,7 @@ foreign import objToHash ::
|
||||
YAML
|
||||
|
||||
valueToYAML :: YValue -> YAML
|
||||
valueToYAML (YObject o) = runFn4 objToHash valueToYAML fst snd $ fromFoldable $ M.toList o
|
||||
valueToYAML (YObject o) = runFn4 objToHash valueToYAML fst snd $ M.toUnfoldable o
|
||||
valueToYAML (YArray a) = unsafeCoerce $ map valueToYAML a
|
||||
valueToYAML (YString s) = unsafeCoerce s
|
||||
valueToYAML (YNumber n) = unsafeCoerce n
|
||||
@ -99,4 +99,3 @@ foreign import toYAMLImpl :: YAML -> String
|
||||
|
||||
printYAML :: forall a. (ToYAML a) => a -> String
|
||||
printYAML = toYAMLImpl <<< valueToYAML <<< toYAML
|
||||
|
||||
|
@ -1,8 +1,9 @@
|
||||
module Test.Instances where
|
||||
|
||||
import Prelude (class Eq, class Show, bind, pure, ($))
|
||||
import Data.Foreign (ForeignError(..), fail, readString)
|
||||
import Data.Foreign.Class (class IsForeign, readProp)
|
||||
import Prelude (class Eq, class Show, bind, pure, ($), (=<<), (<$>), map, (<=<))
|
||||
import Data.Traversable (traverse)
|
||||
import Data.Foreign (readArray, readNumber, readString, readInt, F, Foreign, ForeignError(..), fail, readString)
|
||||
import Data.Foreign.Index (readProp)
|
||||
import Data.Generic (class Generic, gShow, gEq)
|
||||
import Data.YAML.Foreign.Encode
|
||||
|
||||
@ -32,23 +33,27 @@ 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
|
||||
pure $ GeoObject { name, scale, points, mobility, coverage }
|
||||
readGeoObject :: Foreign -> F GeoObject
|
||||
readGeoObject value = do
|
||||
name <- readString =<< readProp "Name" value
|
||||
scale <- readNumber =<< readProp "Scale" value
|
||||
points <- traverse readPoint =<< readArray =<< readProp "Points" value
|
||||
mobility <- readMobility =<< readProp "Mobility" value
|
||||
coverage <- readNumber =<< readProp "Coverage" value
|
||||
pure $ GeoObject { name, scale, points, mobility, coverage }
|
||||
|
||||
instance pointIsForeign :: IsForeign Point where
|
||||
read value = do
|
||||
x <- readProp "X" value
|
||||
y <- readProp "Y" value
|
||||
readPoint :: Foreign -> F Point
|
||||
readPoint value = do
|
||||
-- instance pointIsForeign :: IsForeign Point where
|
||||
-- read value = do
|
||||
x <- readInt =<< readProp "X" value
|
||||
y <- readInt =<< readProp "Y" value
|
||||
pure $ Point x y
|
||||
|
||||
instance mobilityIsForeign :: IsForeign Mobility where
|
||||
read value = do
|
||||
readMobility :: Foreign -> F Mobility
|
||||
readMobility value = do
|
||||
-- instance mobilityIsForeign :: IsForeign Mobility where
|
||||
-- read value = do
|
||||
mob <- readString value
|
||||
case mob of
|
||||
"Fix" -> pure Fix
|
||||
@ -75,4 +80,3 @@ instance archiObjectToYAML :: ToYAML GeoObject where
|
||||
, "Mobility" := o.mobility
|
||||
, "Coverage" := o.coverage
|
||||
]
|
||||
|
||||
|
@ -3,15 +3,17 @@ module Test.Main where
|
||||
import Control.Monad.Eff (Eff)
|
||||
import Control.Monad.Except (runExcept)
|
||||
import Data.Either (Either(..))
|
||||
import Data.Foreign (F)
|
||||
import Data.YAML.Foreign.Decode (readYAML)
|
||||
import Data.Foreign (F, readArray)
|
||||
import Data.YAML.Foreign.Decode (parseYAML)
|
||||
import Data.YAML.Foreign.Encode (printYAML)
|
||||
import Prelude (Unit, bind, ($))
|
||||
import Test.Instances (GeoObject(..), Mobility(..), Point(..))
|
||||
import Data.Traversable (traverse)
|
||||
import Prelude (Unit, bind, ($), void, discard, (>>=))
|
||||
import Test.Instances (readGeoObject, readMobility, readPoint, GeoObject(..), Mobility(..), Point(..))
|
||||
import Test.Spec (describe, it)
|
||||
import Test.Spec.Assertions (shouldEqual)
|
||||
import Test.Spec.Reporter.Console (consoleReporter)
|
||||
import Test.Spec.Runner (RunnerEffects, run)
|
||||
import Control.Monad.Eff.Console (log, CONSOLE)
|
||||
|
||||
yamlInput :: String
|
||||
yamlInput = """
|
||||
@ -41,9 +43,7 @@ yamlInput = """
|
||||
"""
|
||||
|
||||
yamlOutput :: String
|
||||
yamlOutput = """- Coverage: 10
|
||||
Mobility: Fix
|
||||
Name: House
|
||||
yamlOutput = """- Mobility: Fix
|
||||
Points:
|
||||
- X: 10
|
||||
'Y': 10
|
||||
@ -51,10 +51,10 @@ yamlOutput = """- Coverage: 10
|
||||
'Y': 10
|
||||
- X: 5
|
||||
'Y': 5
|
||||
Coverage: 10
|
||||
Name: House
|
||||
Scale: 9.5
|
||||
- Coverage: 10
|
||||
Mobility: Fix
|
||||
Name: Tree
|
||||
- Mobility: Fix
|
||||
Points:
|
||||
- X: 1
|
||||
'Y': 1
|
||||
@ -62,6 +62,8 @@ yamlOutput = """- Coverage: 10
|
||||
'Y': 2
|
||||
- X: 0
|
||||
'Y': 0
|
||||
Coverage: 10
|
||||
Name: Tree
|
||||
Scale: 1
|
||||
"""
|
||||
|
||||
@ -85,13 +87,15 @@ parsedData =
|
||||
|
||||
main :: Eff (RunnerEffects ()) Unit
|
||||
main = run [consoleReporter] do
|
||||
describe "purescript-yaml" do
|
||||
void $ describe "purescript-yaml" do
|
||||
describe "decode" do
|
||||
it "Decodes YAML" do
|
||||
let decoded = (readYAML yamlInput) :: F (Array GeoObject)
|
||||
let decoded =
|
||||
(parseYAML yamlInput) >>=
|
||||
readArray >>=
|
||||
traverse readGeoObject
|
||||
(runExcept decoded) `shouldEqual` (Right parsedData)
|
||||
describe "encode" do
|
||||
void $ describe "encode" do
|
||||
it "Encodes YAML" $ do
|
||||
let encoded = printYAML parsedData
|
||||
encoded `shouldEqual` yamlOutput
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user