Merge pull request jtdaugherty#39 from hankatlas/feature/yaml_update

v2.1.0 -- swapped out yaml package

CHANGELOG.md

@@ -1,3 +1,5 @@
+- Replace outdated yaml-light dependency with yaml package
+
 2.0.0
 -----
 

dbmigrations.cabal

@@ -79,13 +79,15 @@ Library
     directory >= 1.0,
     fgl >= 5.4,
     template-haskell,
-    yaml-light >= 0.1,
+    yaml,
     bytestring >= 0.9,
     string-conversions >= 0.4,
     text >= 0.11,
     configurator >= 0.2,
     split >= 0.2.2,
-    HUnit >= 1.2
+    HUnit >= 1.2,
+    aeson < 2,
+    unordered-containers
 
   Hs-Source-Dirs:    src
   Exposed-Modules:
@@ -118,7 +120,7 @@ test-suite dbmigrations-tests
     directory >= 1.0,
     fgl >= 5.4,
     template-haskell,
-    yaml-light >= 0.1,
+    yaml,
     bytestring >= 0.9,
     string-conversions >= 0.4,
     MissingH,

src/Database/Schema/Migrations/Filesystem.hs

@@ -25,9 +25,11 @@ import qualified Data.Map as Map
 
 import Control.Applicative ( (<$>) )
 import Control.Monad ( filterM )
-import Control.Exception ( IOException, Exception(..), throw, catch )
+import Control.Exception ( Exception(..), throw, catch )
 
-import Data.Yaml.YamlLight
+import Data.Aeson as J (Object, Value(String, Null))
+import Data.HashMap.Strict as M (toList)
+import Data.Yaml
 
 import Database.Schema.Migrations.Migration
     ( Migration(..)
@@ -104,8 +106,8 @@ migrationFromPath path = do
     readMigrationFile = do
       ymlExists <- doesFileExist (addNewMigrationExtension path)
       if ymlExists
-        then parseYamlFile (addNewMigrationExtension path) `catch` (\(e::IOException) -> throwFS $ show e)
-        else parseYamlFile (addMigrationExtension path filenameExtensionTxt) `catch` (\(e::IOException) -> throwFS $ show e)
+        then decodeFileThrow (addNewMigrationExtension path) `catch` (\(e::ParseException) -> throwFS $ show e)
+        else decodeFileThrow (addMigrationExtension path filenameExtensionTxt) `catch` (\(e::ParseException) -> throwFS $ show e)
 
     process name = do
       yaml <- readMigrationFile
@@ -122,11 +124,12 @@ migrationFromPath path = do
             Just m -> return m
         _ -> throwFS $ "Error in " ++ (show path) ++ ": missing required field(s): " ++ (show missing)
 
-getFields :: YamlLight -> [(Text, Text)]
-getFields (YMap mp) = map toPair $ Map.assocs mp
+getFields :: J.Object -> [(Text, Text)]
+getFields mp = map toPair $ M.toList mp
     where
-      toPair :: (YamlLight, YamlLight) -> (Text, Text)
-      toPair (YStr k, YStr v) = (cs k, cs v)
+      toPair :: (Text, Value) -> (Text, Text)
+      toPair (k, J.String v) = (cs k, cs v)
+      toPair (k, J.Null) = (cs k, cs ("" :: String))
       toPair (k, v) = throwFS $ "Error in YAML input; expected string key and string value, got " ++ (show (k, v))
 getFields _ = throwFS "Error in YAML input; expected mapping"
 

test/FilesystemParseTest.hs

@@ -100,8 +100,7 @@ migrationParsingTestCases = [ ("valid_full", Right valid_full)
                             , ("invalid_syntax"
                               , Left $ "Could not parse migration " ++
                                          (fp "invalid_syntax") ++
-                                         ":user error (syntax error: line 7, " ++
-                                         "column 0)")
+                                         ":InvalidYaml (Just (YamlParseException {yamlProblem = \"could not find expected ':'\", yamlContext = \"while scanning a simple key\", yamlProblemMark = YamlMark {yamlIndex = 130, yamlLine = 6, yamlColumn = 0}}))")
                             , ("invalid_timestamp"
                               , Left $ "Could not parse migration " ++
                                          (fp "invalid_timestamp") ++