9d32ba1 · typeable/yaml

git.iko.soy/typeable/yaml

support aeson-2

commit9d32ba1e371f0de82f448410177fbd194d020568 authorLars Kuhtz <lars@kadena.io> dateSat 9 Oct 2021, 21:18 (5 years ago) parentab03235

4 files changed+101−23

compare with master

unifiedsplit

yaml/src/Data/Yaml/Config.hs+24−8 yaml/src/Data/Yaml/Internal.hs+30−8 yaml/src/Data/Yaml/Pretty.hs+16−2 yaml/test/Data/YamlSpec.hs+31−5

yaml/src/Data/Yaml/Config.hs+24−8

@@ -33,7 +33,13 @@ import Data.Monoid

3333import Data.Semigroup

3434import Data.List.NonEmpty (nonEmpty)

3535import Data.Aeson

36+#if MIN_VERSION_aeson(2,0,0)

37+import qualified Data.Aeson.Key as K

38+import qualified Data.Aeson.KeyMap as H

39+import Data.Aeson.KeyMap (KeyMap)

40+#else

3641import qualified Data.HashMap.Strict as H

42+#endif

3743import Data.Text (Text, pack)

3844import System.Environment (getArgs, getEnvironment)

3945import Control.Arrow ((***))

@@ -45,6 +51,16 @@ import qualified Data.Yaml.Include as YI

4551import Data.Maybe (fromMaybe)

4652import qualified Data.Text as T

4753

54+#if MIN_VERSION_aeson(2,0,0)

55+fromText :: T.Text -> Key

56+fromText = K.fromText

57+#else

58+fromText :: T.Text -> T.Text

59+fromText = id

60+

61+type KeyMap a = H.HashMap T.Text a

62+#endif

63+

4864newtype MergedValue = MergedValue { getMergedValue :: Value }

4965

5066instance Semigroup MergedValue where

@@ -64,7 +80,7 @@ mergeValues x _ = x

6480--

6581-- @since 0.8.16

6682applyEnvValue :: Bool -- ^ require an environment variable to be present?

67− -> H.HashMap Text Text -> Value -> Value

83+ -> KeyMap Text -> Value -> Value

6884applyEnvValue requireEnv' env =

6985 goV

7086 where

@@ -74,7 +90,7 @@ applyEnvValue requireEnv' env =

7490 t2 <- T.stripPrefix "_env:" t1

7591 let (name, t3) = T.break (== ':') t2

7692 mdef = fmap parseValue $ T.stripPrefix ":" t3

77− Just $ case H.lookup name env of

93+ Just $ case H.lookup (fromText name) env of

7894 Just val ->

7995 -- If the default value parses as a String, we treat the

8096 -- environment variable as a raw value and do not parse it.

@@ -101,8 +117,8 @@ applyEnvValue requireEnv' env =

101117-- | Get the actual environment as a @HashMap@ from @Text@ to @Text@.

102118--

103119-- @since 0.8.16

104−getCurrentEnv :: IO (H.HashMap Text Text)

105−getCurrentEnv = fmap (H.fromList . map (pack *** pack)) getEnvironment

120+getCurrentEnv :: IO (KeyMap Text)

121+getCurrentEnv = fmap (H.fromList . map (fromText . pack *** pack)) getEnvironment

106122

107123-- | A convenience wrapper around 'applyEnvValue' and 'getCurrentEnv'

108124--

@@ -118,8 +134,8 @@ applyCurrentEnv requireEnv' orig = flip (applyEnvValue requireEnv') orig <$> get

118134data EnvUsage = IgnoreEnv

119135 | UseEnv

120136 | RequireEnv

121− | UseCustomEnv (H.HashMap Text Text)

122− | RequireCustomEnv (H.HashMap Text Text)

137+ | UseCustomEnv (KeyMap Text)

138+ | RequireCustomEnv (KeyMap Text)

123139

124140-- | Do not use any environment variables, instead relying on defaults values

125141-- in the config file.

@@ -146,14 +162,14 @@ requireEnv = RequireEnv

146162-- @HashMap@ as the environment.

147163--

148164-- @since 0.8.16

149−useCustomEnv :: H.HashMap Text Text -> EnvUsage

165+useCustomEnv :: KeyMap Text -> EnvUsage

150166useCustomEnv = UseCustomEnv

151167

152168-- | Same as 'requireEnv', but instead of the actual environment, use the

153169-- provided @HashMap@ as the environment.

154170--

155171-- @since 0.8.16

156−requireCustomEnv :: H.HashMap Text Text -> EnvUsage

172+requireCustomEnv :: KeyMap Text -> EnvUsage

157173requireCustomEnv = RequireCustomEnv

158174

159175-- | Load the settings from the following three sources:

yaml/src/Data/Yaml/Internal.hs+30−8

@@ -33,6 +33,13 @@ import Control.Monad.Trans.Resource (ResourceT, runResourceT)

3333import Control.Monad.State.Strict

3434import Control.Monad.Reader

3535import Data.Aeson

36+#if MIN_VERSION_aeson(2,0,0)

37+import qualified Data.Aeson.Key as K

38+import qualified Data.Aeson.KeyMap as M

39+import Data.Aeson.KeyMap (KeyMap)

40+#else

41+import qualified Data.HashMap.Strict as M

42+#endif

3643import Data.Aeson.Internal (JSONPath, JSONPathElement(..), formatError)

3744import Data.Aeson.Types hiding (parse)

3845import qualified Data.Attoparsec.Text as Atto

@@ -45,14 +52,13 @@ import Data.Char (toUpper, ord)

4552import Data.List

4653import Data.Conduit ((.|), ConduitM, runConduit)

4754import qualified Data.Conduit.List as CL

48−import qualified Data.HashMap.Strict as M

4955import qualified Data.HashSet as HashSet

5056import Data.Map (Map)

5157import qualified Data.Map as Map

5258import Data.Set (Set)

5359import qualified Data.Set as Set

5460import Data.Scientific (Scientific, base10Exponent, coefficient)

55−import Data.Text (Text, pack)

61+import Data.Text (Text)

5662import qualified Data.Text as T

5763import Data.Text.Encoding (decodeUtf8With, encodeUtf8)

5864import Data.Text.Encoding.Error (lenientDecode)

@@ -63,6 +69,22 @@ import Data.Void (Void)

6369import qualified Text.Libyaml as Y

6470import Text.Libyaml hiding (encode, decode, encodeFile, decodeFile)

6571

72+#if MIN_VERSION_aeson(2,0,0)

73+fromText :: T.Text -> K.Key

74+fromText = K.fromText

75+

76+toText :: K.Key -> T.Text

77+toText = K.toText

78+#else

79+fromText :: T.Text -> T.Text

80+fromText = id

81+

82+toText :: Key -> T.Text

83+toText = id

84+

85+type KeyMap a = M.HashMap Text a

86+#endif

87+

6688data ParseException = NonScalarKey

6789 | UnknownAlias { _anchorName :: Y.AnchorName }

6890 | UnexpectedEvent { _received :: Maybe Event

@@ -255,9 +277,9 @@ parseS !n a front = do

255277 o <- local (Index n :) parseO

256278 parseS (succ n) a $ front . (:) o

257279

258−parseM :: Set Text

280+parseM :: Set Key

259281 -> Y.Anchor

260− -> M.HashMap Text Value

282+ -> KeyMap Value

261283 -> ReaderT JSONPath (ConduitM Event o Parse) Value

262284parseM mergedKeys a front = do

263285 me <- lift CL.head

@@ -268,12 +290,12 @@ parseM mergedKeys a front = do

268290 return res

269291 _ -> do

270292 s <- case me of

271− Just (EventScalar v tag style a') -> parseScalar v a' style tag

293+ Just (EventScalar v tag style a') -> fromText <$> parseScalar v a' style tag

272294 Just (EventAlias an) -> do

273295 m <- lookupAnchor an

274296 case m of

275297 Nothing -> liftIO $ throwIO $ UnknownAlias an

276− Just (String t) -> return t

298+ Just (String t) -> return $ fromText t

277299 Just v -> liftIO $ throwIO $ NonStringKeyAlias an v

278300 _ -> do

279301 path <- ask

@@ -286,7 +308,7 @@ parseM mergedKeys a front = do

286308 path <- reverse <$> ask

287309 addWarning (DuplicateKey path)

288310 return (Set.delete s mergedKeys, M.insert s o front)

289− if s == pack "<<"

311+ if s == "<<"

290312 then case o of

291313 Object l -> return (merge l)

292314 Array l -> return $ merge $ foldl' mergeObjects M.empty $ V.toList l

@@ -417,7 +439,7 @@ objToEvents stringStyle = objToEvents' . toJSON

417439 : foldr pairToEvents (EventMappingEnd : rest) (M.toList o)

418440 where

419441 pairToEvents :: Pair -> [Y.Event] -> [Y.Event]

420− pairToEvents (k, v) = objToEvents' (String k) . objToEvents' v

442+ pairToEvents (k, v) = objToEvents' (String $ toText k) . objToEvents' v

421443

422444 objToEvents' (String s) rest = stringScalar stringStyle Nothing s : rest

423445

yaml/src/Data/Yaml/Pretty.hs+16−2

@@ -18,10 +18,16 @@ import Prelude hiding (null)

1818#if !MIN_VERSION_base(4,8,0)

1919import Control.Applicative ((<$>))

2020#endif

21+import Data.Bifunctor (first)

22+#if MIN_VERSION_aeson(2,0,0)

23+import qualified Data.Aeson.Key as K

24+import qualified Data.Aeson.KeyMap as HM

25+#else

26+import qualified Data.HashMap.Strict as HM

27+#endif

2128import Data.Aeson.Types

2229import Data.ByteString (ByteString)

2330import Data.Function (on)

24−import qualified Data.HashMap.Strict as HM

2531import Data.List (sortBy)

2632#if !MIN_VERSION_base(4,8,0)

2733import Data.Monoid

@@ -31,6 +37,14 @@ import qualified Data.Vector as V

3137

3238import Data.Yaml.Builder

3339

40+#if MIN_VERSION_aeson(2,0,0)

41+toText :: Key -> Text

42+toText = K.toText

43+#else

44+toText :: Key -> Text

45+toText = id

46+#endif

47+

3448-- |

3549-- @since 0.8.13

3650data Config = Config

@@ -72,7 +86,7 @@ pretty cfg = go

7286 select

7387 | confDropNull cfg = HM.filter (/= Null)

7488 | otherwise = id

75− in mapping (sort $ HM.toList $ HM.map go $ select o)

89+ in mapping (sort $ fmap (first toText) $ HM.toList $ HM.map go $ select o)

7690 go (Array a) = array (go <$> V.toList a)

7791 go Null = null

7892 go (String s) = string s

yaml/test/Data/YamlSpec.hs+31−5

@@ -32,10 +32,18 @@ import qualified Data.Yaml.Internal as Internal

3232import qualified Data.Yaml.Pretty as Pretty

3333import Data.Yaml (object, array, (.=))

3434import Data.Maybe

35+import qualified Data.HashMap.Strict as HM

36+#if MIN_VERSION_aeson(2,0,0)

37+import qualified Data.Aeson.KeyMap as M

38+import qualified Data.Aeson.Key as K

39+import Data.Aeson.KeyMap (KeyMap)

40+#else

3541import qualified Data.HashMap.Strict as M

42+#endif

3643import qualified Data.Text as T

3744import Data.Aeson.TH

3845import Data.Scientific (Scientific)

46+import Data.String (fromString)

3947import Data.Text (Text)

4048import Data.Text.Encoding (decodeUtf8, encodeUtf8)

4149import Data.Vector (Vector)

@@ -45,6 +53,22 @@ import qualified Data.HashMap.Strict as HM

4553import System.IO (hClose)

4654import System.IO.Temp (withSystemTempFile)

4755

56+#if MIN_VERSION_aeson(2,0,0)

57+fromText :: T.Text -> K.Key

58+fromText = K.fromText

59+

60+toText :: K.Key -> T.Text

61+toText = K.toText

62+#else

63+fromText :: T.Text -> T.Text

64+fromText = id

65+

66+toText :: Key -> T.Text

67+toText = id

68+

69+type KeyMap a = M.HashMap Text a

70+#endif

71+

4872data TestJSON = TestJSON

4973 { string :: Text

5074 , number :: Int

@@ -179,7 +203,7 @@ spec = do

179203

180204 describe "special keys" $ do

181205 let tester key = it (T.unpack key) $

182− let value = object [key .= True]

206+ let value = object [fromText key .= True]

183207 in D.encode value `shouldDecode` value

184208 mapM_ tester specialStrings

185209

@@ -551,7 +575,7 @@ mkStrScalar :: String -> D.Value

551575mkStrScalar = D.String . T.pack

552576

553577mappingKey :: D.Value-> String -> D.Value

554−mappingKey (D.Object m) k = (fromJust . M.lookup (T.pack k) $ m)

578+mappingKey (D.Object m) k = (fromJust . M.lookup (fromText $ T.pack k) $ m)

555579mappingKey _ _ = error "expected Object"

556580

557581sample :: D.Value

@@ -658,7 +682,9 @@ caseSimpleSequenceAlias =

658682caseSimpleMappingAlias :: Assertion

659683caseSimpleMappingAlias =

660684 "map: &anch\n key1: foo\n key2: baz\nmap2: *anch" `shouldDecode`

661− object [(T.pack "map", object [("key1", mkScalar "foo"), ("key2", (mkScalar "baz"))]), (T.pack "map2", object [("key1", (mkScalar "foo")), ("key2", mkScalar "baz")])]

685+ object [(packStr "map", object [("key1", mkScalar "foo"), ("key2", (mkScalar "baz"))]), (packStr "map2", object [("key1", (mkScalar "foo")), ("key2", mkScalar "baz")])]

686+ where

687+ packStr = fromText . T.pack

662688

663689caseMappingAliasBeforeAnchor :: Assertion

664690caseMappingAliasBeforeAnchor =

@@ -811,10 +837,10 @@ caseTruncatesFiles = withSystemTempFile "truncate.yaml" $ \fp h -> do

811837 res <- D.decodeFileEither fp

812838 either (Left . show) Right res `shouldBe` Right val

813839

814−caseSpecialKeys :: (HashMap Text () -> B8.ByteString) -> Assertion

840+caseSpecialKeys :: (KeyMap () -> B8.ByteString) -> Assertion

815841caseSpecialKeys encoder = do

816842 let keys = T.words "true false NO YES 1.2 1e5 null"

817− bs = encoder $ M.fromList $ map (, ()) keys

843+ bs = encoder $ M.fromList $ map (, ()) $ fmap fromText keys

818844 text = decodeUtf8 bs

819845 forM_ keys $ \key -> do

820846 let quoted = T.concat ["'", key, "'"]