yaml-unscrambler 0.1.0.6 → 0.1.0.7
raw patch · 17 files changed
+558/−685 lines, 17 filesdep +text-builder-devdep −text-builderPVP ok
version bump matches the API change (PVP)
Dependencies added: text-builder-dev
Dependencies removed: text-builder
API changes (from Hackage documentation)
Files
- library/YamlUnscrambler.hs +197/−222
- library/YamlUnscrambler/AsciiAtto.hs +6/−10
- library/YamlUnscrambler/CompactErrRendering.hs +26/−25
- library/YamlUnscrambler/Err.hs +59/−68
- library/YamlUnscrambler/Expectations.hs +66/−86
- library/YamlUnscrambler/Model.hs +14/−18
- library/YamlUnscrambler/Prelude.hs +41/−87
- library/YamlUnscrambler/Util/ByteString.hs +2/−4
- library/YamlUnscrambler/Util/HashMap.hs +3/−5
- library/YamlUnscrambler/Util/List.hs +1/−3
- library/YamlUnscrambler/Util/Maybe.hs +1/−3
- library/YamlUnscrambler/Util/Text.hs +3/−5
- library/YamlUnscrambler/Util/Vector.hs +3/−5
- library/YamlUnscrambler/Util/Word8.hs +4/−7
- library/YamlUnscrambler/Util/Yaml.hs +7/−9
- test/Main.hs +123/−126
- yaml-unscrambler.cabal +2/−2
library/YamlUnscrambler.hs view
@@ -1,66 +1,72 @@ module YamlUnscrambler-(- -- * Execution- parseText,- parseByteString,- getExpectations,- -- * DSL- -- ** Value- Value,- value,- nullableValue,- -- *** Helpers- sequenceValue,- mappingValue,- scalarsValue,- -- ** Scalar- Scalar,- stringScalar,- nullScalar,- boolScalar,- scientificScalar,- doubleScalar,- rationalScalar,- boundedIntegerScalar,- unboundedIntegerScalar,- timestampScalar,- dayScalar,- timeScalar,- uuidScalar,- binaryScalar,- -- ** Mapping- Mapping,- foldMapping,- byKeyMapping,- -- ** Sequence- Sequence,- foldSequence,- byOrderSequence,- byKeySequence,- -- ** String- String,- textString,- enumString,- formattedString,- attoparsedString,- -- ** ByKey- ByKey,- atByKey,- atOneOfByKey,- -- ** ByOrder- ByOrder,- fetchByOrder,- -- * Value types- MaxInputSize(..),- Signed(..),- NumeralSystem(..),- CaseSensitive(..),-)+ ( -- * Execution+ parseText,+ parseByteString,+ getExpectations,++ -- * DSL++ -- ** Value+ Value,+ value,+ nullableValue,++ -- *** Helpers+ sequenceValue,+ mappingValue,+ scalarsValue,++ -- ** Scalar+ Scalar,+ stringScalar,+ nullScalar,+ boolScalar,+ scientificScalar,+ doubleScalar,+ rationalScalar,+ boundedIntegerScalar,+ unboundedIntegerScalar,+ timestampScalar,+ dayScalar,+ timeScalar,+ uuidScalar,+ binaryScalar,++ -- ** Mapping+ Mapping,+ foldMapping,+ byKeyMapping,++ -- ** Sequence+ Sequence,+ foldSequence,+ byOrderSequence,+ byKeySequence,++ -- ** String+ String,+ textString,+ enumString,+ formattedString,+ attoparsedString,++ -- ** ByKey+ ByKey,+ atByKey,+ atOneOfByKey,++ -- ** ByOrder+ ByOrder,+ fetchByOrder,++ -- * Value types+ MaxInputSize (..),+ Signed (..),+ NumeralSystem (..),+ CaseSensitive (..),+ ) where -import YamlUnscrambler.Prelude hiding (String)-import YamlUnscrambler.Model-import qualified YamlUnscrambler.Err as Err import qualified Attoparsec.Time.ByteString as AsciiAtto import qualified Control.Foldl as Fold import qualified Data.Attoparsec.ByteString.Char8 as AsciiAtto@@ -79,16 +85,17 @@ import qualified Text.Libyaml as Libyaml import qualified YamlUnscrambler.AsciiAtto as AsciiAtto import qualified YamlUnscrambler.CompactErrRendering as CompactErrRendering+import qualified YamlUnscrambler.Err as Err import qualified YamlUnscrambler.Expectations as Ex+import YamlUnscrambler.Model+import YamlUnscrambler.Prelude hiding (String) import qualified YamlUnscrambler.Util.ByteString as ByteString import qualified YamlUnscrambler.Util.HashMap as HashMap import qualified YamlUnscrambler.Util.Text as Text import qualified YamlUnscrambler.Util.Vector as Vector import qualified YamlUnscrambler.Util.Yaml as Yaml - -- * Execution-------------------------- parseText :: Value a -> Text -> Either Text a parseText value =@@ -100,22 +107,18 @@ Yaml.RawDoc value map <- Yaml.parseByteStringToRawDoc input valueParser value map & first CompactErrRendering.renderErrAtPath -{-|-Get a tree of expectations, which can then be converted into-documentation for people working with the YAML document or-into one of the spec formats (e.g., YAML Spec, JSON Spec).--}+-- |+-- Get a tree of expectations, which can then be converted into+-- documentation for people working with the YAML document or+-- into one of the spec formats (e.g., YAML Spec, JSON Spec). getExpectations :: Value a -> Ex.Value getExpectations = valueExpectation - -- *-------------------------- -data Value a =- Value {- valueExpectation :: Ex.Value,+data Value a = Value+ { valueExpectation :: Ex.Value, valueParser :: Yaml.YamlValue -> Yaml.AnchorMap -> Either Err.ErrAtPath a } deriving (Functor)@@ -138,8 +141,8 @@ [] -> Left (Err.ErrAtPath [] (Err.UnexpectedScalarErr expectations)) _ ->- runExcept (asum (fmap parse scalars)) &- first convErr+ runExcept (asum (fmap parse scalars))+ & first convErr where parse scalar = except $ first (Last . Just) $ scalarParser scalar bytes tag style@@ -172,7 +175,6 @@ (fmap (fmap Just) sequences) -- ** Helpers-------------------------- sequenceValue :: Sequence a -> Value a sequenceValue sequence =@@ -186,71 +188,60 @@ scalarsValue scalars = value scalars Nothing Nothing - -- *-------------------------- -data Scalar a =- Scalar {- scalarExpectation :: Ex.Scalar,+data Scalar a = Scalar+ { scalarExpectation :: Ex.Scalar, scalarParser :: ByteString -> Libyaml.Tag -> Libyaml.Style -> Either Text a } deriving (Functor) bytesParsingScalar :: Ex.Scalar -> (ByteString -> Either Text a) -> Scalar a bytesParsingScalar expectation parser =- Scalar expectation (\ bytes _ _ -> parser bytes)+ Scalar expectation (\bytes _ _ -> parser bytes) attoparsedScalar :: Ex.Scalar -> AsciiAtto.Parser a -> Scalar a attoparsedScalar expectation parser = bytesParsingScalar expectation $- first (const "") . AsciiAtto.parseOnly (parser <* AsciiAtto.endOfInput)+ first (const "") . AsciiAtto.parseOnly (parser <* AsciiAtto.endOfInput) sizedScalar :: MaxInputSize -> Scalar a -> Scalar a sizedScalar (MaxInputSize maxInputSize) (Scalar {..}) =- Scalar scalarExpectation $ \ bytes tag style ->+ Scalar scalarExpectation $ \bytes tag style -> if ByteString.length bytes <= maxInputSize- then- scalarParser bytes tag style- else- Left ("Input is longer then the expected maximum of " <> showAsText maxInputSize <> " bytes")+ then scalarParser bytes tag style+ else Left ("Input is longer then the expected maximum of " <> showAsText maxInputSize <> " bytes") stringScalar :: String a -> Scalar a stringScalar (String exp parse) = bytesParsingScalar (Ex.StringScalar exp)- (\ bytes -> first showAsText (Text.decodeUtf8' bytes) >>= parse)+ (\bytes -> first showAsText (Text.decodeUtf8' bytes) >>= parse) nullScalar :: a -> Scalar a nullScalar a =- Scalar Ex.NullScalar $ \ bytes tag _ ->- if- tag == Libyaml.NullTag ||- ByteString.null bytes ||- bytes == "~" ||- ByteString.saysNullInCiAscii bytes- then- Right a- else- Left "Not null"+ Scalar Ex.NullScalar $ \bytes tag _ ->+ if tag == Libyaml.NullTag+ || ByteString.null bytes+ || bytes == "~"+ || ByteString.saysNullInCiAscii bytes+ then Right a+ else Left "Not null" boolScalar :: Scalar Bool boolScalar =- bytesParsingScalar Ex.BoolScalar $ \ bytes ->+ bytesParsingScalar Ex.BoolScalar $ \bytes -> if ByteString.length bytes <= 5- then let- lowercased =- ByteString.lowercaseInAscii bytes- in if elem lowercased ["y", "yes", "on", "true", "t", "1"]- then- return True- else if elem lowercased ["n", "no", "off", "false", "f", "0"]- then- return False- else- Left "Not a boolean"- else- Left "Not a boolean"+ then+ let lowercased =+ ByteString.lowercaseInAscii bytes+ in if elem lowercased ["y", "yes", "on", "true", "t", "1"]+ then return True+ else+ if elem lowercased ["n", "no", "off", "false", "f", "0"]+ then return False+ else Left "Not a boolean"+ else Left "Not a boolean" scientificScalar :: Scalar Scientific scientificScalar =@@ -263,11 +254,10 @@ rationalScalar :: MaxInputSize -> Scalar Rational rationalScalar a = sizedScalar a $- attoparsedScalar (Ex.RationalScalar a) AsciiAtto.rational+ attoparsedScalar (Ex.RationalScalar a) AsciiAtto.rational -{-|-E.g., 'Int', 'Int64', 'Word', but not 'Integer'.--}+-- |+-- E.g., 'Int', 'Int64', 'Word', but not 'Integer'. boundedIntegerScalar :: (Integral a, FiniteBits a) => Signed -> NumeralSystem -> Scalar a boundedIntegerScalar a b = attoparsedScalar (Ex.BoundedIntegerScalar a b) (AsciiAtto.integralScalar a b)@@ -275,7 +265,7 @@ unboundedIntegerScalar :: MaxInputSize -> Signed -> NumeralSystem -> Scalar Integer unboundedIntegerScalar a b c = sizedScalar a $- attoparsedScalar (Ex.UnboundedIntegerScalar a b c) (AsciiAtto.integralScalar b c)+ attoparsedScalar (Ex.UnboundedIntegerScalar a b c) (AsciiAtto.integralScalar b c) timestampScalar :: Scalar UTCTime timestampScalar =@@ -291,7 +281,7 @@ uuidScalar :: Scalar UUID uuidScalar =- bytesParsingScalar Ex.UuidScalar $ \ bytes ->+ bytesParsingScalar Ex.UuidScalar $ \bytes -> case UUID.fromASCIIBytes bytes of Just uuid -> return uuid@@ -300,23 +290,19 @@ binaryScalar :: Scalar ByteString binaryScalar =- bytesParsingScalar Ex.Base64BinaryScalar $ \ bytes ->- let- bytesWithoutNewlines =- ByteString.filter (/= 10) bytes- in case Base64.decodeBase64 bytesWithoutNewlines of- Right res ->- return res- Left err ->- Left err-+ bytesParsingScalar Ex.Base64BinaryScalar $ \bytes ->+ let bytesWithoutNewlines =+ ByteString.filter (/= 10) bytes+ in case Base64.decodeBase64 bytesWithoutNewlines of+ Right res ->+ return res+ Left err ->+ Left err -- *-------------------------- -data Mapping a =- Mapping {- mappingExpectation :: Ex.Mapping,+data Mapping a = Mapping+ { mappingExpectation :: Ex.Mapping, mappingParser :: [(Text, Yaml.YamlValue)] -> Yaml.AnchorMap -> Either Err.ErrAtPath a } deriving (Functor)@@ -328,8 +314,8 @@ parser where parser input anchorMap =- foldM step foldInit input &- fmap foldExtract+ foldM step foldInit input+ & fmap foldExtract where step state (keyInput, valInput) = do@@ -338,8 +324,8 @@ return $! foldStep state (zip parsedKey parsedVal) where keyErr =- Err.ErrAtPath [] .- Err.KeyErr (stringExpectation key) keyInput+ Err.ErrAtPath []+ . Err.KeyErr (stringExpectation key) keyInput byKeyMapping :: CaseSensitive -> ByKey Text a -> Mapping a byKeyMapping caseSensitive byKey =@@ -352,36 +338,33 @@ where parser = if coerce caseSensitive- then let- map =- HashMap.fromList input- lookup k =- HashMap.lookup k map- lookupFirst kl =- HashMap.lookupFirst kl map- in byKeyParser byKey id lookup lookupFirst- else let- map =- HashMap.fromList (fmap (first Text.toLower) input)- lookup k =- HashMap.lookup (Text.toLower k) map- lookupFirst kl =- HashMap.lookupFirst (fmap Text.toLower kl) map- in byKeyParser byKey id lookup lookupFirst+ then+ let map =+ HashMap.fromList input+ lookup k =+ HashMap.lookup k map+ lookupFirst kl =+ HashMap.lookupFirst kl map+ in byKeyParser byKey id lookup lookupFirst+ else+ let map =+ HashMap.fromList (fmap (first Text.toLower) input)+ lookup k =+ HashMap.lookup (Text.toLower k) map+ lookupFirst kl =+ HashMap.lookupFirst (fmap Text.toLower kl) map+ in byKeyParser byKey id lookup lookupFirst keysErr keys = Err.ErrAtPath [] $- Err.NoneOfMappingKeysFoundErr (byKeyExpectation byKey) caseSensitive keysAvail (toList keys)+ Err.NoneOfMappingKeysFoundErr (byKeyExpectation byKey) caseSensitive keysAvail (toList keys) where keysAvail = fmap fst input - -- *-------------------------- -data Sequence a =- Sequence {- sequenceExpectation :: Ex.Sequence,+data Sequence a = Sequence+ { sequenceExpectation :: Ex.Sequence, sequenceParser :: [Yaml.YamlValue] -> Yaml.AnchorMap -> Either Err.ErrAtPath a } deriving (Functor)@@ -393,28 +376,28 @@ parser where parser input anchorMap =- foldM step (0 :: Int, foldInit) input &- fmap (foldExtract . snd)+ foldM step (0 :: Int, foldInit) input+ & fmap (foldExtract . snd) where step (!index, !state) input =- valueParser value input anchorMap &- first (Err.atSegment (showAsText index)) &- fmap (\ a -> (succ index, foldStep state a))+ valueParser value input anchorMap+ & first (Err.atSegment (showAsText index))+ & fmap (\a -> (succ index, foldStep state a)) byOrderSequence :: ByOrder a -> Sequence a byOrderSequence (ByOrder {..}) = Sequence (Ex.ByOrderSequence byOrderExpectation) parser- where- parser input anchorMap =- runExceptT (runReaderT (evalStateT byOrderParser (0, input)) anchorMap) &- either Left (first mapErr)- where- mapErr =- \ case- NotEnoughElementsByOrderErr a ->- Err.ErrAtPath [] $+ where+ parser input anchorMap =+ runExceptT (runReaderT (evalStateT byOrderParser (0, input)) anchorMap)+ & either Left (first mapErr)+ where+ mapErr =+ \case+ NotEnoughElementsByOrderErr a ->+ Err.ErrAtPath [] $ Err.NotEnoughElementsErr byOrderExpectation a byKeySequence :: ByKey Int a -> Sequence a@@ -424,28 +407,24 @@ expectation = Ex.ByKeySequence byKeyExpectation parser input =- let- vector =- Vector.fromList input- lookup k =- vector Vector.!? k- lookupFirst kl =- Vector.lookupFirst kl vector- in \ anchorMap ->- runExceptT (byKeyParser showAsText lookup lookupFirst anchorMap) &- either Left (first keysErr)+ let vector =+ Vector.fromList input+ lookup k =+ vector Vector.!? k+ lookupFirst kl =+ Vector.lookupFirst kl vector+ in \anchorMap ->+ runExceptT (byKeyParser showAsText lookup lookupFirst anchorMap)+ & either Left (first keysErr) where keysErr keys = Err.ErrAtPath [] $- Err.NoneOfSequenceKeysFoundErr byKeyExpectation (toList keys)-+ Err.NoneOfSequenceKeysFoundErr byKeyExpectation (toList keys) -- *-------------------------- -data String a =- String {- stringExpectation :: Ex.String,+data String a = String+ { stringExpectation :: Ex.String, stringParser :: Text -> Either Text a } deriving (Functor)@@ -463,20 +442,20 @@ {-# NOINLINE lookup #-} lookup = if length assocList > 512- then if caseSensitive- then let- hashMap =- HashMap.fromList assocList- in flip HashMap.lookup hashMap- else let- hashMap =- HashMap.fromList (fmap (first Text.toLower) assocList)- in flip HashMap.lookup hashMap . Text.toLower- else if caseSensitive- then- flip List.lookup assocList- else- flip List.lookup (fmap (first Text.toLower) assocList) . Text.toLower+ then+ if caseSensitive+ then+ let hashMap =+ HashMap.fromList assocList+ in flip HashMap.lookup hashMap+ else+ let hashMap =+ HashMap.fromList (fmap (first Text.toLower) assocList)+ in flip HashMap.lookup hashMap . Text.toLower+ else+ if caseSensitive+ then flip List.lookup assocList+ else flip List.lookup (fmap (first Text.toLower) assocList) . Text.toLower parser text = case lookup text of Just a -> return a@@ -494,13 +473,10 @@ (Ex.FormattedString format) (first fromString . TextAtto.parseOnly parser) - -- *-------------------------- -data ByKey key a =- ByKey {- byKeyExpectation :: Ex.ByKey key,+data ByKey key a = ByKey+ { byKeyExpectation :: Ex.ByKey key, byKeyParser :: (key -> Text) -> (key -> Maybe Yaml.YamlValue) ->@@ -516,13 +492,13 @@ (<*>) (ByKey le lp) (ByKey re rp) = ByKey (Ex.BothByKey le re)- (\ a b c d -> lp a b c d <*> rp a b c d)+ (\a b c d -> lp a b c d <*> rp a b c d) instance Selective (ByKey key) where select (ByKey le lp) (ByKey re rp) = ByKey (Ex.BothByKey le re)- (\ a b c d -> select (lp a b c d) (rp a b c d))+ (\a b c d -> select (lp a b c d) (rp a b c d)) instance Alternative (ByKey key) where empty =@@ -532,7 +508,7 @@ (<|>) (ByKey le lp) (ByKey re rp) = ByKey (Ex.EitherByKey le re)- (\ a b c d -> lp a b c d <|> rp a b c d)+ (\a b c d -> lp a b c d <|> rp a b c d) atByKey :: key -> Value a -> ByKey key a atByKey key valueSpec =@@ -543,8 +519,9 @@ parser renderKey lookup _ env = case lookup key of Just val ->- lift $ first (Err.atSegment (renderKey key)) $- valueParser valueSpec val env+ lift $+ first (Err.atSegment (renderKey key)) $+ valueParser valueSpec val env Nothing -> throwE (pure key) @@ -557,22 +534,20 @@ parser renderKey _ lookup env = case lookup keys of Just (key, val) ->- lift $ first (Err.atSegment (renderKey key)) $- valueParser valueSpec val env+ lift $+ first (Err.atSegment (renderKey key)) $+ valueParser valueSpec val env Nothing -> throwE (fromList keys) - -- *-------------------------- -data ByOrderErr =- NotEnoughElementsByOrderErr- Int+data ByOrderErr+ = NotEnoughElementsByOrderErr+ Int -data ByOrder a =- ByOrder {- byOrderExpectation :: Ex.ByOrder,+data ByOrder a = ByOrder+ { byOrderExpectation :: Ex.ByOrder, byOrderParser :: StateT (Int, [Yaml.YamlValue]) (ReaderT Yaml.AnchorMap (ExceptT ByOrderErr (Either Err.ErrAtPath))) a } deriving (Functor)
library/YamlUnscrambler/AsciiAtto.hs view
@@ -1,19 +1,15 @@-module YamlUnscrambler.AsciiAtto-where+module YamlUnscrambler.AsciiAtto where -import YamlUnscrambler.Prelude-import YamlUnscrambler.Model-import Data.Attoparsec.ByteString.Char8 import Attoparsec.Time.ByteString-+import Data.Attoparsec.ByteString.Char8+import YamlUnscrambler.Model+import YamlUnscrambler.Prelude integralScalar :: (Integral a, Bits a) => Signed -> NumeralSystem -> Parser a integralScalar (Signed isSigned) numeralSystem = if isSigned- then- signed numeralParser- else- numeralParser+ then signed numeralParser+ else numeralParser where numeralParser = case numeralSystem of
library/YamlUnscrambler/CompactErrRendering.hs view
@@ -1,21 +1,19 @@ module YamlUnscrambler.CompactErrRendering-(- renderErrAtPath,-)+ ( renderErrAtPath,+ ) where -import YamlUnscrambler.Prelude hiding (intercalate)-import YamlUnscrambler.Model-import Text.Builder+import qualified Data.Text as Text+import qualified Data.Text.Encoding as Text+import TextBuilderDev import qualified YamlUnscrambler.Err as Err import qualified YamlUnscrambler.Expectations as Ex-import qualified Data.Text.Encoding as Text-import qualified Data.Text as Text-+import YamlUnscrambler.Model+import YamlUnscrambler.Prelude hiding (intercalate) renderErrAtPath :: Err.ErrAtPath -> Text renderErrAtPath =- run . errAtPath+ buildText . errAtPath path a = "/" <> intercalate "/" (fmap text a)@@ -24,20 +22,22 @@ "Error at path " <> path a <> ". " <> reason b reason =- \ case+ \case Err.KeyErr a b c ->- text c <> ". On input: " <> string (show b) <> ". " <>- "Expecting: " <> stringExpectation a+ text c <> ". On input: " <> string (show b) <> ". "+ <> "Expecting: "+ <> stringExpectation a Err.NoneOfMappingKeysFoundErr a b c d ->- "None of keys found " <> caseSensitively b <> ": " <> string (show d) <> ". " <>- "Keys available: " <> string (show c)+ "None of keys found " <> caseSensitively b <> ": " <> string (show d) <> ". "+ <> "Keys available: "+ <> string (show c) Err.NoneOfSequenceKeysFoundErr a b -> "None of indices found: " <> string (show b) Err.ScalarErr a b c d e ->- foldMap (\ a -> text a <> ". ") (mfilter (not . Text.null) e) <>- "Expecting one of the following formats: " <>- intercalate ", " (fmap scalarExpectation a) <>- foldMap (\ a -> ". Got input: " <> string (show a)) (Text.decodeUtf8' b)+ foldMap (\a -> text a <> ". ") (mfilter (not . Text.null) e)+ <> "Expecting one of the following formats: "+ <> intercalate ", " (fmap scalarExpectation a)+ <> foldMap (\a -> ". Got input: " <> string (show a)) (Text.decodeUtf8' b) Err.UnexpectedScalarErr a -> "Unexpected scalar value" Err.UnexpectedMappingErr a ->@@ -47,11 +47,12 @@ Err.UnknownAnchorErr a -> "Unknown anchor: " <> text a Err.NotEnoughElementsErr a b ->- "Not enough elements: " <> decimal b <> ". " <>- "Expecting: " <> byOrderExpectation a+ "Not enough elements: " <> decimal b <> ". "+ <> "Expecting: "+ <> byOrderExpectation a scalarExpectation =- \ case+ \case Ex.StringScalar a -> stringExpectation a Ex.NullScalar ->@@ -80,7 +81,7 @@ "binary data in Base-64" stringExpectation =- \ case+ \case Ex.AnyString -> "any string" Ex.OneOfString a b ->@@ -92,7 +93,7 @@ decimal . count 0 where count !a =- \ case+ \case Ex.AnyByOrder -> a Ex.BothByOrder b c ->@@ -118,7 +119,7 @@ bool "unsigned" "signed" a numeralSystem =- \ case+ \case DecimalNumeralSystem -> "decimal" HexadecimalNumeralSystem ->
library/YamlUnscrambler/Err.hs view
@@ -1,77 +1,68 @@ module YamlUnscrambler.Err-(- ErrAtPath(..),- Err(..),- atSegment,- -- *- MaxInputSize(..),- Signed(..),- NumeralSystem(..),- CaseSensitive(..),- -- * Reexports from \"libyaml\"- Libyaml.Tag(..),- Libyaml.Style(..),-)+ ( ErrAtPath (..),+ Err (..),+ atSegment,++ -- *+ MaxInputSize (..),+ Signed (..),+ NumeralSystem (..),+ CaseSensitive (..),++ -- * Reexports from \"libyaml\"+ Libyaml.Tag (..),+ Libyaml.Style (..),+ ) where -import YamlUnscrambler.Prelude hiding (String)-import YamlUnscrambler.Model-import qualified YamlUnscrambler.Expectations as Ex import qualified Text.Libyaml as Libyaml-import qualified Text.Builder as TextBuilder-+import qualified YamlUnscrambler.Expectations as Ex+import YamlUnscrambler.Model+import YamlUnscrambler.Prelude hiding (String) -data ErrAtPath =- ErrAtPath [Text] Err+data ErrAtPath+ = ErrAtPath [Text] Err -data Err =- KeyErr- Ex.String- {-^ Key expectation. -}- Text- {-^ Key input. -}- Text- {-^ String parsing error. -}- |- NoneOfMappingKeysFoundErr- (Ex.ByKey Text)- CaseSensitive- [Text]- {-^ Available keys. -}- [Text]- {-^ Keys looked up. -}- |- NoneOfSequenceKeysFoundErr- (Ex.ByKey Int)- [Int]- |- ScalarErr- [Ex.Scalar]- {-^ Expected formats. -}- ByteString- {-^ Input. -}- Libyaml.Tag- {-^ Tag. -}- Libyaml.Style- {-^ Style. -}- (Maybe Text)- {-^ Last error. -}- |- UnexpectedScalarErr- Ex.Value- |- UnexpectedMappingErr- Ex.Value- |- UnexpectedSequenceErr- Ex.Value- |- UnknownAnchorErr- Text- |- NotEnoughElementsErr- Ex.ByOrder- Int+data Err+ = KeyErr+ Ex.String+ -- ^ Key expectation.+ Text+ -- ^ Key input.+ Text+ -- ^ String parsing error.+ | NoneOfMappingKeysFoundErr+ (Ex.ByKey Text)+ CaseSensitive+ [Text]+ -- ^ Available keys.+ [Text]+ -- ^ Keys looked up.+ | NoneOfSequenceKeysFoundErr+ (Ex.ByKey Int)+ [Int]+ | ScalarErr+ [Ex.Scalar]+ -- ^ Expected formats.+ ByteString+ -- ^ Input.+ Libyaml.Tag+ -- ^ Tag.+ Libyaml.Style+ -- ^ Style.+ (Maybe Text)+ -- ^ Last error.+ | UnexpectedScalarErr+ Ex.Value+ | UnexpectedMappingErr+ Ex.Value+ | UnexpectedSequenceErr+ Ex.Value+ | UnknownAnchorErr+ Text+ | NotEnoughElementsErr+ Ex.ByOrder+ Int atSegment :: Text -> ErrAtPath -> ErrAtPath atSegment seg (ErrAtPath path err) =
library/YamlUnscrambler/Expectations.hs view
@@ -1,107 +1,87 @@ module YamlUnscrambler.Expectations-(- Value(..),- Scalar(..),- Mapping(..),- Sequence(..),- String(..),- ByKey(..),- ByOrder(..),- -- *- MaxInputSize(..),- Signed(..),- NumeralSystem(..),- CaseSensitive(..),-)+ ( Value (..),+ Scalar (..),+ Mapping (..),+ Sequence (..),+ String (..),+ ByKey (..),+ ByOrder (..),++ -- *+ MaxInputSize (..),+ Signed (..),+ NumeralSystem (..),+ CaseSensitive (..),+ ) where -import YamlUnscrambler.Prelude hiding (String) import YamlUnscrambler.Model+import YamlUnscrambler.Prelude hiding (String) import qualified YamlUnscrambler.Util.Maybe as Maybe - -- *-------------------------- -data Value =- Value- [Scalar]- (Maybe Mapping)- (Maybe Sequence)+data Value+ = Value+ [Scalar]+ (Maybe Mapping)+ (Maybe Sequence) -data Scalar =- StringScalar String- |- NullScalar- |- BoolScalar- |- ScientificScalar- |- DoubleScalar- |- RationalScalar MaxInputSize- |- BoundedIntegerScalar Signed NumeralSystem- |- UnboundedIntegerScalar MaxInputSize Signed NumeralSystem- |- Iso8601TimestampScalar- |- Iso8601DayScalar- |- Iso8601TimeScalar- |- UuidScalar- |- Base64BinaryScalar+data Scalar+ = StringScalar String+ | NullScalar+ | BoolScalar+ | ScientificScalar+ | DoubleScalar+ | RationalScalar MaxInputSize+ | BoundedIntegerScalar Signed NumeralSystem+ | UnboundedIntegerScalar MaxInputSize Signed NumeralSystem+ | Iso8601TimestampScalar+ | Iso8601DayScalar+ | Iso8601TimeScalar+ | UuidScalar+ | Base64BinaryScalar -data Mapping =- MonomorphicMapping String Value- |- ByKeyMapping CaseSensitive (ByKey Text)+data Mapping+ = MonomorphicMapping String Value+ | ByKeyMapping CaseSensitive (ByKey Text) -data Sequence =- MonomorphicSequence Value- |- ByOrderSequence ByOrder- |- ByKeySequence (ByKey Int)+data Sequence+ = MonomorphicSequence Value+ | ByOrderSequence ByOrder+ | ByKeySequence (ByKey Int) -- *-------------------------- -data String =- {-| Any string as it is. -}- AnyString- |- {-| One of options. Suitable for enumerations. -}- OneOfString CaseSensitive [Text] {-^ Options. -}- |- {-| Must conform to a textually described format. -}- FormattedString Text {-^ Description of the format. -}--data ByKey key =- AnyByKey- |- NoByKey- |- EitherByKey (ByKey key) (ByKey key)- |- BothByKey (ByKey key) (ByKey key)- |- LookupByKey [key] {-^ Keys to lookup. -} Value+data String+ = -- | Any string as it is.+ AnyString+ | -- | One of options. Suitable for enumerations.+ OneOfString+ CaseSensitive+ [Text]+ -- ^ Options.+ | -- | Must conform to a textually described format.+ FormattedString+ Text+ -- ^ Description of the format. -data ByOrder =- AnyByOrder- |- BothByOrder ByOrder ByOrder- |- FetchByOrder Value+data ByKey key+ = AnyByKey+ | NoByKey+ | EitherByKey (ByKey key) (ByKey key)+ | BothByKey (ByKey key) (ByKey key)+ | LookupByKey+ [key]+ -- ^ Keys to lookup.+ Value +data ByOrder+ = AnyByOrder+ | BothByOrder ByOrder ByOrder+ | FetchByOrder Value -- *-------------------------- instance Semigroup Value where (<>) (Value lScalars lMappings lSequences) (Value rScalars rMappings rSequences) =
library/YamlUnscrambler/Model.hs view
@@ -1,24 +1,20 @@-module YamlUnscrambler.Model-where+module YamlUnscrambler.Model where import YamlUnscrambler.Prelude --{-|-Specification of the maximum allowed length for the input.-A safety measure to ensure that the parser doesn't exhaust memory-when parsing to unlimited datatypes.--}-newtype MaxInputSize =- MaxInputSize Int+-- |+-- Specification of the maximum allowed length for the input.+-- A safety measure to ensure that the parser doesn't exhaust memory+-- when parsing to unlimited datatypes.+newtype MaxInputSize+ = MaxInputSize Int -newtype Signed =- Signed Bool+newtype Signed+ = Signed Bool -data NumeralSystem =- DecimalNumeralSystem- |- HexadecimalNumeralSystem+data NumeralSystem+ = DecimalNumeralSystem+ | HexadecimalNumeralSystem -newtype CaseSensitive =- CaseSensitive Bool+newtype CaseSensitive+ = CaseSensitive Bool
library/YamlUnscrambler/Prelude.hs view
@@ -1,25 +1,38 @@ module YamlUnscrambler.Prelude-( - module Exports,- showAsText,-)+ ( module Exports,+ showAsText,+ ) where --- base--------------------------+import Acc as Exports (Acc) import Control.Applicative as Exports import Control.Arrow as Exports hiding (first, second) import Control.Category as Exports import Control.Concurrent as Exports import Control.Exception as Exports-import Control.Monad as Exports hiding (fail, mapM_, sequence_, forM_, msum, mapM, sequence, forM)-import Control.Monad.IO.Class as Exports+import Control.Foldl as Exports (Fold (..))+import Control.Monad as Exports hiding (fail, forM, forM_, mapM, mapM_, msum, sequence, sequence_)+import Control.Monad.Cont.Class as Exports+import Control.Monad.Error.Class as Exports hiding (Error (..)) import Control.Monad.Fail as Exports import Control.Monad.Fix as Exports hiding (fix)+import Control.Monad.IO.Class as Exports+import Control.Monad.Reader.Class as Exports import Control.Monad.ST as Exports+import Control.Monad.State.Class as Exports+import Control.Monad.Trans.Class as Exports+import Control.Monad.Trans.Cont as Exports hiding (callCC, shift)+import Control.Monad.Trans.Except as Exports (Except, ExceptT (ExceptT), catchE, except, mapExcept, mapExceptT, runExcept, runExceptT, throwE, withExcept, withExceptT)+import Control.Monad.Trans.Maybe as Exports+import Control.Monad.Trans.Reader as Exports (Reader, ReaderT (ReaderT), mapReader, mapReaderT, runReader, runReaderT, withReader, withReaderT)+import Control.Monad.Trans.State.Strict as Exports (State, StateT (StateT), evalState, evalStateT, execState, execStateT, mapState, mapStateT, runState, runStateT, withState, withStateT)+import Control.Monad.Trans.Writer.Strict as Exports (Writer, WriterT (..), execWriter, execWriterT, mapWriter, mapWriterT, runWriter)+import Control.Monad.Writer.Class as Exports+import Control.Selective as Exports import Data.Bifunctor as Exports import Data.Bits as Exports import Data.Bool as Exports+import Data.ByteString as Exports (ByteString) import Data.Char as Exports import Data.Coerce as Exports import Data.Complex as Exports@@ -31,21 +44,32 @@ import Data.Function as Exports hiding (id, (.)) import Data.Functor as Exports import Data.Functor.Compose as Exports-import Data.Int as Exports+import Data.HashMap.Strict as Exports (HashMap)+import Data.HashSet as Exports (HashSet)+import Data.Hashable as Exports (Hashable) import Data.IORef as Exports+import Data.Int as Exports import Data.Ix as Exports-import Data.List as Exports hiding (sortOn, isSubsequenceOf, uncons, concat, foldr, foldl1, maximum, minimum, product, sum, all, and, any, concatMap, elem, foldl, foldr1, notElem, or, find, maximumBy, minimumBy, mapAccumL, mapAccumR, foldl')-import Data.List.NonEmpty as Exports (NonEmpty(..))+import Data.List as Exports hiding (all, and, any, concat, concatMap, elem, find, foldl, foldl', foldl1, foldr, foldr1, isSubsequenceOf, mapAccumL, mapAccumR, maximum, maximumBy, minimum, minimumBy, notElem, or, product, sortOn, sum, uncons)+import Data.List.NonEmpty as Exports (NonEmpty (..))+import Data.Map.Strict as Exports (Map) import Data.Maybe as Exports import Data.Monoid as Exports hiding (Alt) import Data.Ord as Exports import Data.Proxy as Exports import Data.Ratio as Exports import Data.STRef as Exports+import Data.Scientific as Exports (Scientific) import Data.String as Exports+import Data.Text as Exports (Text)+import Data.Time as Exports+import Data.Time.Clock.POSIX as Exports+import Data.Time.Clock.System as Exports import Data.Traversable as Exports import Data.Tuple as Exports+import Data.UUID as Exports (UUID) import Data.Unique as Exports+import Data.Vector as Exports (Vector) import Data.Version as Exports import Data.Void as Exports import Data.Word as Exports@@ -54,12 +78,11 @@ import Foreign.Ptr as Exports import Foreign.StablePtr as Exports import Foreign.Storable as Exports-import GHC.Conc as Exports hiding (orElse, withMVar, threadWaitWriteSTM, threadWaitWrite, threadWaitReadSTM, threadWaitRead)-import GHC.Exts as Exports (IsList(..), lazy, inline, sortWith, groupWith)+import GHC.Conc as Exports hiding (orElse, threadWaitRead, threadWaitReadSTM, threadWaitWrite, threadWaitWriteSTM, withMVar)+import GHC.Exts as Exports (IsList (..), groupWith, inline, lazy, sortWith) import GHC.Generics as Exports (Generic) import GHC.IO.Exception as Exports import Numeric as Exports-import Prelude as Exports hiding (fail, concat, foldr, mapM_, sequence_, foldl1, maximum, minimum, product, sum, all, and, any, concatMap, elem, foldl, foldr1, notElem, or, mapM, sequence, id, (.)) import System.Environment as Exports import System.Exit as Exports import System.IO as Exports (Handle, hClose)@@ -69,80 +92,11 @@ import System.Mem.StableName as Exports import System.Timeout as Exports import Text.ParserCombinators.ReadP as Exports (ReadP, ReadS, readP_to_S, readS_to_P)-import Text.ParserCombinators.ReadPrec as Exports (ReadPrec, readPrec_to_P, readP_to_Prec, readPrec_to_S, readS_to_Prec)-import Text.Printf as Exports (printf, hPrintf)-import Text.Read as Exports (Read(..), readMaybe, readEither)+import Text.ParserCombinators.ReadPrec as Exports (ReadPrec, readP_to_Prec, readPrec_to_P, readPrec_to_S, readS_to_Prec)+import Text.Printf as Exports (hPrintf, printf)+import Text.Read as Exports (Read (..), readEither, readMaybe) import Unsafe.Coerce as Exports---- selective---------------------------import Control.Selective as Exports---- text---------------------------import Data.Text as Exports (Text)---- bytestring---------------------------import Data.ByteString as Exports (ByteString)---- vector---------------------------import Data.Vector as Exports (Vector)---- hashable---------------------------import Data.Hashable as Exports (Hashable)---- containers---------------------------import Data.Map.Strict as Exports (Map)---- unordered-containers---------------------------import Data.HashSet as Exports (HashSet)-import Data.HashMap.Strict as Exports (HashMap)---- uuid---------------------------import Data.UUID as Exports (UUID)---- foldl---------------------------import Control.Foldl as Exports (Fold(..))---- transformers---------------------------import Control.Monad.IO.Class as Exports-import Control.Monad.Trans.Class as Exports-import Control.Monad.Trans.Cont as Exports hiding (shift, callCC)-import Control.Monad.Trans.Except as Exports (ExceptT(ExceptT), Except, except, runExcept, runExceptT, mapExcept, mapExceptT, withExcept, withExceptT, throwE, catchE)-import Control.Monad.Trans.Maybe as Exports-import Control.Monad.Trans.Reader as Exports (Reader, runReader, mapReader, withReader, ReaderT(ReaderT), runReaderT, mapReaderT, withReaderT)-import Control.Monad.Trans.State.Strict as Exports (State, runState, evalState, execState, mapState, withState, StateT(StateT), runStateT, evalStateT, execStateT, mapStateT, withStateT)-import Control.Monad.Trans.Writer.Strict as Exports (Writer, runWriter, execWriter, mapWriter, WriterT(..), execWriterT, mapWriterT)---- mtl---------------------------import Control.Monad.Cont.Class as Exports-import Control.Monad.Error.Class as Exports hiding (Error(..))-import Control.Monad.Reader.Class as Exports-import Control.Monad.State.Class as Exports-import Control.Monad.Writer.Class as Exports---- scientific---------------------------import Data.Scientific as Exports (Scientific)---- time---------------------------import Data.Time as Exports-import Data.Time.Clock.System as Exports-import Data.Time.Clock.POSIX as Exports---- acc---------------------------import Acc as Exports (Acc)+import Prelude as Exports hiding (all, and, any, concat, concatMap, elem, fail, foldl, foldl1, foldr, foldr1, id, mapM, mapM_, maximum, minimum, notElem, or, product, sequence, sequence_, sum, (.)) showAsText :: Show a => a -> Text showAsText = show >>> fromString
library/YamlUnscrambler/Util/ByteString.hs view
@@ -1,10 +1,8 @@-module YamlUnscrambler.Util.ByteString-where+module YamlUnscrambler.Util.ByteString where -import YamlUnscrambler.Prelude hiding (map, length) import Data.ByteString+import YamlUnscrambler.Prelude hiding (length, map) import qualified YamlUnscrambler.Util.Word8 as Word8- lowercaseInAscii = map Word8.lowercaseInAscii
library/YamlUnscrambler/Util/HashMap.hs view
@@ -1,10 +1,8 @@-module YamlUnscrambler.Util.HashMap-where+module YamlUnscrambler.Util.HashMap where -import YamlUnscrambler.Prelude hiding (lookup) import Data.HashMap.Strict-+import YamlUnscrambler.Prelude hiding (lookup) lookupFirst :: (Hashable k, Eq k) => [k] -> HashMap k v -> Maybe (k, v) lookupFirst keys map =- getFirst (foldMap (\ k -> First (fmap (k,) (lookup k map))) keys)+ getFirst (foldMap (\k -> First (fmap (k,) (lookup k map))) keys)
library/YamlUnscrambler/Util/List.hs view
@@ -1,8 +1,6 @@-module YamlUnscrambler.Util.List-where+module YamlUnscrambler.Util.List where import YamlUnscrambler.Prelude hiding (lookup)- firstNonEmpty :: [a] -> [a] -> [a] firstNonEmpty a b =
library/YamlUnscrambler/Util/Maybe.hs view
@@ -1,8 +1,6 @@-module YamlUnscrambler.Util.Maybe-where+module YamlUnscrambler.Util.Maybe where import YamlUnscrambler.Prelude hiding (lookup)- firstNonEmpty :: Maybe a -> Maybe a -> Maybe a firstNonEmpty a b =
library/YamlUnscrambler/Util/Text.hs view
@@ -1,10 +1,8 @@-module YamlUnscrambler.Util.Text-where+module YamlUnscrambler.Util.Text where -import YamlUnscrambler.Prelude-import qualified Data.Attoparsec.Text as Atto import qualified Attoparsec.Data as Atto-+import qualified Data.Attoparsec.Text as Atto+import YamlUnscrambler.Prelude deshowIfPossible :: Text -> Text deshowIfPossible a =
library/YamlUnscrambler/Util/Vector.hs view
@@ -1,10 +1,8 @@-module YamlUnscrambler.Util.Vector-where+module YamlUnscrambler.Util.Vector where -import YamlUnscrambler.Prelude as Prelude hiding (lookup) import Data.Vector-+import YamlUnscrambler.Prelude as Prelude hiding (lookup) lookupFirst :: [Int] -> Vector a -> Maybe (Int, a) lookupFirst keys vector =- getFirst (Prelude.foldMap (\ k -> First (fmap (k,) (vector !? k))) keys)+ getFirst (Prelude.foldMap (\k -> First (fmap (k,) (vector !? k))) keys)
library/YamlUnscrambler/Util/Word8.hs view
@@ -1,14 +1,11 @@-module YamlUnscrambler.Util.Word8-where+module YamlUnscrambler.Util.Word8 where import YamlUnscrambler.Prelude - lowercaseInAscii :: Word8 -> Word8 lowercaseInAscii a =- if- 65 <= a && a <= 90 ||- 192 <= a && a <= 214 ||- 216 <= a && a <= 222+ if 65 <= a && a <= 90+ || 192 <= a && a <= 214+ || 216 <= a && a <= 222 then a + 32 else a
library/YamlUnscrambler/Util/Yaml.hs view
@@ -1,18 +1,16 @@-module YamlUnscrambler.Util.Yaml-where+module YamlUnscrambler.Util.Yaml where -import YamlUnscrambler.Prelude import qualified Conduit+import qualified Data.Text.Encoding as Text import qualified Data.Yaml as Yaml import qualified Data.Yaml.Parser as YamlParser-import qualified Data.Text.Encoding as Text import qualified Text.Libyaml as Libyaml-+import YamlUnscrambler.Prelude parseByteStringToRawDoc :: ByteString -> Either Text YamlParser.RawDoc parseByteStringToRawDoc input = first showAsText $- unsafePerformIO $- try @SomeException $- Conduit.runConduitRes $- Conduit.fuse (Libyaml.decode input) (YamlParser.sinkRawDoc)+ unsafePerformIO $+ try @SomeException $+ Conduit.runConduitRes $+ Conduit.fuse (Libyaml.decode input) (YamlParser.sinkRawDoc)
test/Main.hs view
@@ -1,76 +1,75 @@ module Main where -import Prelude hiding (assert)+import qualified Control.Foldl as Fold+import qualified Data.Text as Text import GHC.Exts (fromList)+import qualified NeatInterpolation as NeatInterpolation+import qualified Test.QuickCheck as QuickCheck import Test.QuickCheck.Instances import Test.Tasty-import Test.Tasty.Runners import Test.Tasty.HUnit import Test.Tasty.QuickCheck+import Test.Tasty.Runners import qualified YamlUnscrambler as U-import qualified Test.QuickCheck as QuickCheck-import qualified Control.Foldl as Fold-import qualified NeatInterpolation as NeatInterpolation-import qualified Data.Text as Text-+import Prelude hiding (assert) main =- defaultMain $ - testGroup "All tests" [- testCase "Should fail on sequence when no sequence is specified" $ let- unscrambler =- U.value [] (Just mapping) Nothing- where- mapping =- U.foldMapping (,) Fold.list U.textString value- where- value =- U.value [nullScalar, intScalar] Nothing Nothing+ defaultMain $+ testGroup+ "All tests"+ [ testCase "Should fail on sequence when no sequence is specified" $+ let unscrambler =+ U.value [] (Just mapping) Nothing where- nullScalar =- U.nullScalar Nothing- intScalar =- fmap Just $ U.boundedIntegerScalar @Int (U.Signed True) U.DecimalNumeralSystem- input =- [NeatInterpolation.text|+ mapping =+ U.foldMapping (,) Fold.list U.textString value+ where+ value =+ U.value [nullScalar, intScalar] Nothing Nothing+ where+ nullScalar =+ U.nullScalar Nothing+ intScalar =+ fmap Just $ U.boundedIntegerScalar @Int (U.Signed True) U.DecimalNumeralSystem+ input =+ [NeatInterpolation.text| a: 2 b: 3 c: - 1 - 2 |]- in case U.parseText unscrambler input of- Right res ->- assertFailure (show res)- Left failure ->- assertEqual (Text.unpack failure) "Error at path /c. Unexpected sequence value" failure- ,- testCase "Domain sum-type regression" $ let- unscrambler =- doc- where- doc =- U.mappingValue $- U.byKeyMapping (U.CaseSensitive True) $- asum [- Just <$> U.atByKey "sums" sum,- pure Nothing- ]- sum =- U.mappingValue $- U.foldMapping (,) Fold.list U.textString sumVariant- sumVariant =- U.mappingValue $- U.foldMapping (,) Fold.list U.textString params- params =- U.value [nullScalar, intScalar] Nothing Nothing- where- nullScalar =- U.nullScalar Nothing- intScalar =- fmap Just $ U.boundedIntegerScalar @Int (U.Signed True) U.DecimalNumeralSystem- input =- [NeatInterpolation.text|+ in case U.parseText unscrambler input of+ Right res ->+ assertFailure (show res)+ Left failure ->+ assertEqual (Text.unpack failure) "Error at path /c. Unexpected sequence value" failure,+ testCase "Domain sum-type regression" $+ let unscrambler =+ doc+ where+ doc =+ U.mappingValue $+ U.byKeyMapping (U.CaseSensitive True) $+ asum+ [ Just <$> U.atByKey "sums" sum,+ pure Nothing+ ]+ sum =+ U.mappingValue $+ U.foldMapping (,) Fold.list U.textString sumVariant+ sumVariant =+ U.mappingValue $+ U.foldMapping (,) Fold.list U.textString params+ params =+ U.value [nullScalar, intScalar] Nothing Nothing+ where+ nullScalar =+ U.nullScalar Nothing+ intScalar =+ fmap Just $ U.boundedIntegerScalar @Int (U.Signed True) U.DecimalNumeralSystem+ input =+ [NeatInterpolation.text| sums: A: a:@@ -78,83 +77,81 @@ - Bool b: Char, Double |]- in case U.parseText unscrambler input of- Right res ->- assertFailure (show res)- Left failure ->- assertEqual "" "Error at path /sums/A/a. Unexpected sequence value" failure- ,- testCase "Domain sum-type correct" $ let- unscrambler =- doc- where- doc =- U.mappingValue $- U.byKeyMapping (U.CaseSensitive True) $- asum [- Just <$> U.atByKey "sums" sum,- pure Nothing- ]- sum =- U.mappingValue $- U.foldMapping (,) Fold.list U.textString sumVariant- sumVariant =- U.mappingValue $- U.foldMapping (,) Fold.list U.textString params- params =- U.value [nullScalar, valueScalar] Nothing Nothing- where- nullScalar =- U.nullScalar Nothing- valueScalar =- fmap Just $ U.stringScalar U.textString- input =- [NeatInterpolation.text|+ in case U.parseText unscrambler input of+ Right res ->+ assertFailure (show res)+ Left failure ->+ assertEqual "" "Error at path /sums/A/a. Unexpected sequence value" failure,+ testCase "Domain sum-type correct" $+ let unscrambler =+ doc+ where+ doc =+ U.mappingValue $+ U.byKeyMapping (U.CaseSensitive True) $+ asum+ [ Just <$> U.atByKey "sums" sum,+ pure Nothing+ ]+ sum =+ U.mappingValue $+ U.foldMapping (,) Fold.list U.textString sumVariant+ sumVariant =+ U.mappingValue $+ U.foldMapping (,) Fold.list U.textString params+ params =+ U.value [nullScalar, valueScalar] Nothing Nothing+ where+ nullScalar =+ U.nullScalar Nothing+ valueScalar =+ fmap Just $ U.stringScalar U.textString+ input =+ [NeatInterpolation.text| sums: A: a: Text b: Int |]- in case U.parseText unscrambler input of- Right res ->- assertEqual "" (Just [("A", [("a", Just "Text"), ("b", Just "Int")])]) res- Left failure ->- assertFailure (Text.unpack failure)- ,- testCase "Scalar errors are readable" $ let- unscrambler =- doc- where- doc =- U.mappingValue $- U.byKeyMapping (U.CaseSensitive True) $- asum [- Just <$> U.atByKey "sums" sum,- pure Nothing- ]- sum =- U.mappingValue $- U.foldMapping (,) Fold.list U.textString sumVariant- sumVariant =- U.mappingValue $- U.foldMapping (,) Fold.list U.textString params- params =- U.value [nullScalar, intScalar] Nothing Nothing- where- nullScalar =- U.nullScalar Nothing- intScalar =- fmap Just $ U.boundedIntegerScalar @Int (U.Signed True) U.DecimalNumeralSystem- input =- [NeatInterpolation.text|+ in case U.parseText unscrambler input of+ Right res ->+ assertEqual "" (Just [("A", [("a", Just "Text"), ("b", Just "Int")])]) res+ Left failure ->+ assertFailure (Text.unpack failure),+ testCase "Scalar errors are readable" $+ let unscrambler =+ doc+ where+ doc =+ U.mappingValue $+ U.byKeyMapping (U.CaseSensitive True) $+ asum+ [ Just <$> U.atByKey "sums" sum,+ pure Nothing+ ]+ sum =+ U.mappingValue $+ U.foldMapping (,) Fold.list U.textString sumVariant+ sumVariant =+ U.mappingValue $+ U.foldMapping (,) Fold.list U.textString params+ params =+ U.value [nullScalar, intScalar] Nothing Nothing+ where+ nullScalar =+ U.nullScalar Nothing+ intScalar =+ fmap Just $ U.boundedIntegerScalar @Int (U.Signed True) U.DecimalNumeralSystem+ input =+ [NeatInterpolation.text| sums: A: a: Int b: Char |]- in case U.parseText unscrambler input of- Right res ->- assertFailure (show res)- Left failure ->- assertEqual "" "Error at path /sums/A/a. Expecting one of the following formats: null, signed decimal. Got input: \"Int\"" failure- ]+ in case U.parseText unscrambler input of+ Right res ->+ assertFailure (show res)+ Left failure ->+ assertEqual "" "Error at path /sums/A/a. Expecting one of the following formats: null, signed decimal. Got input: \"Int\"" failure+ ]
yaml-unscrambler.cabal view
@@ -1,5 +1,5 @@ name: yaml-unscrambler-version: 0.1.0.6+version: 0.1.0.7 synopsis: Flexible declarative YAML parsing toolkit stability: Experimental homepage: https://github.com/nikita-volkov/yaml-unscrambler@@ -54,7 +54,7 @@ scientific >=0.3.6.2 && <0.4, selective >=0.5 && <0.6, text >=1 && <3,- text-builder >=0.6.6.1 && <0.7,+ text-builder-dev >=0.1 && <0.2, time >=1.9 && <2, transformers >=0.5 && <0.7, unordered-containers >=0.2.10 && <0.3,