phino 0.0.134 → 0.0.135
raw patch · 14 files changed
+246/−151 lines, 14 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
+ Yaml: parseCondition :: Object -> Parser Condition
Files
- README.md +70/−70
- phino.cabal +1/−1
- src/Builder.hs +3/−0
- src/Files.hs +8/−4
- src/Lambdas.hs +22/−2
- src/Regexp.hs +24/−5
- src/XMIR.hs +10/−3
- src/Yaml.hs +53/−55
- test/BuilderSpec.hs +7/−0
- test/FilesSpec.hs +13/−0
- test/LambdasSpec.hs +5/−0
- test/RegexpSpec.hs +7/−0
- test/XMIRSpec.hs +16/−0
- test/YamlSpec.hs +7/−11
README.md view
@@ -34,7 +34,7 @@ ```bash cabal update-cabal install --overwrite-policy=always phino-0.0.133+cabal install --overwrite-policy=always phino-0.0.134 phino --version ``` @@ -1191,9 +1191,9 @@ * `contextualize` - function of two arguments, that rewrites given expression depending on provided context according to the contextualization [rules](assets/contextualize.jpg)-* `random-tau` - creates attribute with random unique name. Accepts bindings,- and attributes. Ensures that created attribute is not present in list of- provided attributes and does not exist as attribute in provided bindings.+* `random-tau` - creates an attribute with a random unique name. It accepts no+ arguments; uniqueness is guaranteed across all names already taken in the+ document. * `dataize` - dataizes given expression and returns bytes. * `concat` - accepts bytes or dataizable expressions as arguments, concatenates them into single sequence and convert it to expression@@ -1317,103 +1317,103 @@ === parse/phi === warmup: 3 iterations batches: 10 x 1- total: 1785285.297 μs- avg: 178528.530 μs- min: 164868.992 μs- max: 209121.132 μs- std dev: 15515.800 μs+ total: 1821425.151 μs+ avg: 182142.515 μs+ min: 170750.493 μs+ max: 209499.629 μs+ std dev: 15132.778 μs === parse/xmir === warmup: 3 iterations batches: 10 x 1- total: 7506298.288 μs- avg: 750629.829 μs- min: 683506.496 μs- max: 819105.157 μs- std dev: 44112.176 μs+ total: 7708084.189 μs+ avg: 770808.419 μs+ min: 701670.454 μs+ max: 827995.748 μs+ std dev: 39123.293 μs === rewrite/normalize === warmup: 3 iterations batches: 10 x 1- total: 495636.638 μs- avg: 49563.664 μs- min: 48083.779 μs- max: 51678.568 μs- std dev: 1163.452 μs+ total: 507305.249 μs+ avg: 50730.525 μs+ min: 48912.624 μs+ max: 54335.144 μs+ std dev: 1596.161 μs === print/sweet/multiline === warmup: 3 iterations batches: 10 x 1- total: 4148167.742 μs- avg: 414816.774 μs- min: 390353.762 μs- max: 438468.832 μs- std dev: 15702.253 μs+ total: 4188218.626 μs+ avg: 418821.863 μs+ min: 403263.572 μs+ max: 449353.774 μs+ std dev: 14512.853 μs === print/sweet/flat === warmup: 3 iterations batches: 10 x 1- total: 4103860.150 μs- avg: 410386.015 μs- min: 400487.779 μs- max: 422099.714 μs- std dev: 6878.840 μs+ total: 4025720.702 μs+ avg: 402572.070 μs+ min: 382540.835 μs+ max: 428138.472 μs+ std dev: 11933.717 μs === print/salty/multiline === warmup: 3 iterations batches: 10 x 1- total: 13505706.601 μs- avg: 1350570.660 μs- min: 1323552.942 μs- max: 1388589.251 μs- std dev: 22111.111 μs+ total: 14045902.469 μs+ avg: 1404590.247 μs+ min: 1384313.216 μs+ max: 1438197.181 μs+ std dev: 15501.328 μs === morph/symbolic/demo/e1 === warmup: 3 iterations batches: 10 x 1- total: 16623322.804 μs- avg: 1662332.280 μs- min: 1634287.226 μs- max: 1712122.691 μs- std dev: 26925.390 μs+ total: 880309.436 μs+ avg: 88030.944 μs+ min: 86359.252 μs+ max: 90267.072 μs+ std dev: 1248.861 μs === morph/symbolic/demo/e2 ===- warmup: 2 iterations- batches: 4 x 1- total: 18971323.304 μs- avg: 4742830.826 μs- min: 4710439.768 μs- max: 4785557.203 μs- std dev: 31923.645 μs+ warmup: 3 iterations+ batches: 10 x 1+ total: 1215850.964 μs+ avg: 121585.096 μs+ min: 117038.580 μs+ max: 138033.783 μs+ std dev: 5877.028 μs === morph/symbolic/demo/e3 === warmup: 3 iterations batches: 10 x 1- total: 9393523.305 μs- avg: 939352.330 μs- min: 926573.125 μs- max: 955737.287 μs- std dev: 9251.489 μs+ total: 1844780.073 μs+ avg: 184478.007 μs+ min: 180633.446 μs+ max: 192191.924 μs+ std dev: 3471.827 μs === morph/symbolic/demo/e4 === warmup: 3 iterations batches: 10 x 1- total: 6172093.232 μs- avg: 617209.323 μs- min: 609699.156 μs- max: 622461.534 μs- std dev: 3958.833 μs+ total: 617914.516 μs+ avg: 61791.452 μs+ min: 60976.930 μs+ max: 62245.020 μs+ std dev: 354.771 μs === morph/symbolic/demo/e5 === warmup: 3 iterations batches: 10 x 1- total: 657478.162 μs- avg: 65747.816 μs- min: 64867.966 μs- max: 66985.074 μs- std dev: 698.720 μs+ total: 185308.236 μs+ avg: 18530.824 μs+ min: 17898.792 μs+ max: 19243.924 μs+ std dev: 442.924 μs === morph/symbolic/native/e5 ===- warmup: 0 iterations- batches: 1 x 1- total: 24700300.710 μs- avg: 24700300.710 μs- min: 24700300.710 μs- max: 24700300.710 μs- std dev: 0.000 μs+ warmup: 2 iterations+ batches: 4 x 1+ total: 18057164.992 μs+ avg: 4514291.248 μs+ min: 4280917.084 μs+ max: 4860213.506 μs+ std dev: 215452.202 μs ``` The results were calculated in [this GHA job][benchmark-gha]-on 2026-09-18 at 21:12,+on 2026-09-20 at 06:19, on Linux with 4 CPUs. <!-- benchmark_end -->@@ -1463,4 +1463,4 @@ [jna-native]: https://github.com/java-native-access/jna/blob/master/src/com/sun/jna/Native.java [jeo]: https://github.com/objectionary/jeo-maven-plugin [issue-1291]: https://github.com/objectionary/phino/issues/1291-[benchmark-gha]: https://github.com/objectionary/phino/actions/runs/35395119960+[benchmark-gha]: https://github.com/objectionary/phino/actions/runs/35493401441
phino.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.0 name: phino-version: 0.0.134+version: 0.0.135 license: MIT synopsis: Command-Line Manipulator of 𝜑-Calculus Expressions description: Please see the README on GitHub at <https://github.com/objectionary/phino#readme>
src/Builder.hs view
@@ -158,6 +158,9 @@ dispatched <- buildExpression ex subst at' <- buildAttribute at subst Right (ExDispatch dispatched at')+buildExpression (ExApplication ExRoot (ArTau AtRho expr)) subst = do+ _ <- buildExpression expr subst+ Right ExRoot buildExpression (ExApplication expr arg) subst = do applied <- buildExpression expr subst arg' <- buildArgument arg subst
src/Files.hs view
@@ -10,7 +10,7 @@ import Control.Exception (Exception, onException, throwIO) import Control.Monad (forM, when)-import System.Directory (copyPermissions, doesDirectoryExist, doesFileExist, listDirectory, removeFile, renameFile)+import System.Directory (copyPermissions, doesDirectoryExist, doesFileExist, listDirectory, pathIsSymbolicLink, removeFile, renameFile) import System.FilePath (takeDirectory, takeFileName, (</>)) import System.IO (Handle, hClose, hPutStr, hSetEncoding, openTempFileWithDefaultPermissions, utf8) import Text.Printf (printf)@@ -53,9 +53,13 @@ forM nested ( \path -> do+ isLink <- pathIsSymbolicLink path isDir <- doesDirectoryExist path- if isDir- then allPathsIn path- else return [path]+ if isLink+ then return []+ else+ if isDir+ then allPathsIn path+ else return [path] ) return (concat paths)
src/Lambdas.hs view
@@ -271,9 +271,10 @@ readLambdas path = do entries <- Yaml.decodeFileEither path >>= either broken pure mapM_ (unique entries) entries- registered <- Lambdas <$> mapM keyed entries+ registered <- mapM keyed entries+ overlaps path registered logDebug (printf "Loaded %d λ function(s) from '%s'" (length entries) path)- pure registered+ pure (Lambdas registered) where broken :: Yaml.ParseException -> IO [Lambda] broken failure = throwIO (BrokenLambdas path (Yaml.prettyPrintParseException failure))@@ -294,6 +295,25 @@ unreadable :: Text -> (a, String) -> IO b unreadable key (_, failure) = throwIO (BrokenLambdas path (printf "the key '%s' is not a regular expression: %s" (T.unpack key) failure))++ overlaps :: FilePath -> [(Regex, Lambda)] -> IO ()+ overlaps file = check+ where+ check :: [(Regex, Lambda)] -> IO ()+ check [] = pure ()+ check ((first, left) : rest) = do+ mapM_ (pair first left) rest+ check rest+ pair :: Regex -> Lambda -> (Regex, Lambda) -> IO ()+ pair first left (second, right)+ | matchTest first (encodeUtf8 right._key)+ || matchTest second (encodeUtf8 left._key) =+ throwIO+ ( BrokenLambdas+ file+ (printf "the keys '%s' and '%s' match some of the same lambda names" (T.unpack left._key) (T.unpack right._key))+ )+ | otherwise = pure () -- The entry whose key matches the whole λ name, if any. There is at most one: -- the keys are unique, so a name either has a λ function or has none at all.
src/Regexp.hs view
@@ -6,8 +6,9 @@ import Control.Exception import Data.Array (bounds, (!)) import qualified Data.ByteString.Char8 as B-import Data.Char (isDigit)+import Data.Char (isDigit, ord) import Data.Maybe (fromMaybe)+import Text.Read (readMaybe) import qualified Text.Regex.PCRE.ByteString as R compile :: B.ByteString -> IO R.Regex@@ -51,8 +52,9 @@ in if null digits then B.singleton '$' : go rest else- let idx = read digits- val = fromMaybe (B.pack ('$' : digits)) (safeIndex idx groups)+ let val = case readMaybe digits of+ Nothing -> B.pack ('$' : digits)+ Just idx -> fromMaybe (B.pack ('$' : digits)) (safeIndex idx groups) in val : go afterDigits go (c : rest) = B.singleton c : go rest safeIndex :: Int -> [B.ByteString] -> Maybe B.ByteString@@ -91,8 +93,25 @@ let replacement = substituteGroups rep groups if len == 0 then- let next = B.take 1 rest2+ let next = B.take (utf8Width rest2) rest2 in if B.null next then return $ B.concat [acc, before, replacement]- else go (B.drop 1 rest2) (B.concat [acc, before, replacement, next])+ else go (B.drop (B.length next) rest2) (B.concat [acc, before, replacement, next]) else go rest2 (B.concat [acc, before, replacement])+ utf8Width :: B.ByteString -> Int+ utf8Width bytes =+ case B.uncons bytes of+ Nothing -> 0+ Just (lead, rest)+ | ord lead < 0xC0 -> 1+ | ord lead < 0xE0 -> continuationWidth 2 rest+ | ord lead < 0xF0 -> continuationWidth 3 rest+ | ord lead < 0xF8 -> continuationWidth 4 rest+ | otherwise -> 1+ continuationWidth :: Int -> B.ByteString -> Int+ continuationWidth width rest =+ if B.length rest >= width - 1 && B.all isContinuation (B.take (width - 1) rest)+ then width+ else 1+ isContinuation :: Char -> Bool+ isContinuation byte = ord byte >= 0x80 && ord byte < 0xC0
src/XMIR.hs view
@@ -160,7 +160,9 @@ formationBinding (BiTau AtRho expr) ctx = Just <$> namedBinding (show AtRho) expr ctx formationBinding (BiTau AtPhi expr) ctx = Just <$> namedBinding (show AtPhi) expr ctx formationBinding (BiDelta bytes) _ = pure (Just (NodeContent (T.pack (printBytes bytes))))-formationBinding (BiLambda (Function name)) _ = pure (Just (object [("name", show AtLambda)] [NodeContent name]))+formationBinding (BiLambda (Function name)) _+ | "Φ." `T.isPrefixOf` name = pure (Just (object [("atom", T.unpack name), ("name", show AtLambda)] []))+ | otherwise = pure (Just (object [("name", show AtLambda)] [NodeContent name])) formationBinding (BiVoid AtRho) _ = pure Nothing formationBinding (BiVoid AtPhi) _ = pure (Just (object [("name", show AtPhi), ("base", "∅")] [])) formationBinding (BiVoid (AtLabel label)) _ = pure (Just (object [("name", T.unpack label), ("base", "∅")] []))@@ -481,7 +483,7 @@ | not (hasAttr "base" cur) = do name <- getAttr "name" cur case name of- "λ" -> BiLambda . Function <$> lambdaFunction+ "λ" -> BiLambda . Function <$> atomOrLambda ('α' : _) -> throwIO (InvalidXMIRFormat "Formation child @name can't start with α" cur) "φ" -> BiTau AtPhi <$> xmirToFormation cur (name : fqn) "ρ" -> BiTau AtRho <$> xmirToFormation cur (name : fqn)@@ -503,6 +505,11 @@ -- The λ function name is carried by the text of the marker element. XMIR -- coming from elsewhere holds no name, so fall back to the position in the -- tree, which is the only hint left+ atomOrLambda :: IO T.Text+ atomOrLambda+ | hasAttr "atom" cur = T.pack <$> getAttr "atom" cur+ | otherwise = lambdaFunction+ lambdaFunction :: IO T.Text lambdaFunction | hasText cur = T.strip . T.pack <$> getText cur@@ -641,5 +648,5 @@ getText :: C.Cursor -> IO String getText cur = case [t | c <- C.child cur, NodeContent t <- [C.node c]] of- (t : _) -> pure (T.unpack t) [] -> throwIO (InvalidXMIRFormat "Text content inside <o> element can't be empty" cur)+ texts -> pure (T.unpack (T.concat texts))
src/Yaml.hs view
@@ -99,61 +99,59 @@ ] instance FromJSON Condition where- parseJSON =- withObject- "Condition"- ( \v -> do- validateYamlObject v ["and", "or", "not", "nf", "absolute", "eq", "gt", "in", "matches", "part-of", "disjoint", "formation"]- asum- [ do- conds <- v .: "and"- if null conds- then fail "The 'and' condition requires at least one element"- else pure (And conds)- , do- conds <- v .: "or"- if null conds- then fail "The 'or' condition requires at least one element"- else pure (Or conds)- , Not <$> v .: "not"- , NF <$> v .: "nf"- , Absolute <$> v .: "absolute"- , IsFormation <$> v .: "formation"- , do- vals <- v .: "disjoint"- case vals of- [attrs_, bds_] -> Disjoint <$> parseJSON attrs_ <*> parseJSON bds_- _ -> fail "'disjoint' expects exactly two arguments"- , do- vals <- v .: "eq"- case vals of- [left_, right_] -> Eq <$> parseJSON left_ <*> parseJSON right_- _ -> fail "'eq' expects exactly two arguments"- , do- vals <- v .: "gt"- case vals of- [left_, right_] -> Gt <$> parseJSON left_ <*> parseJSON right_- _ -> fail "'gt' expects exactly two arguments"- , do- vals <- v .: "in"- case vals of- [attr_, binding_] -> do- attr <- parseJSON attr_- bd <- parseJSON binding_- pure (In attr bd)- _ -> fail "'in' expects exactly two arguments"- , do- vals <- v .: "matches"- case vals of- [pat, ex] -> Matches <$> parseJSON pat <*> parseJSON ex- _ -> fail "'matches' expects exactly two arguments"- , do- vals <- v .: "part-of"- case vals of- [ex, bd] -> PartOf <$> parseJSON ex <*> parseJSON bd- _ -> fail "'part-of' expects exactly two arguments"- ]- )+ parseJSON = withObject "Condition" parseCondition++parseCondition :: Object -> Parser Condition+parseCondition v = do+ validateYamlObject v ["and", "or", "not", "nf", "absolute", "eq", "gt", "in", "matches", "part-of", "disjoint", "formation"]+ case KeyMap.keys v of+ [key] -> case Key.toString key of+ "and" -> do+ conds <- v .: "and"+ if null conds+ then fail "The 'and' condition requires at least one element"+ else pure (And conds)+ "or" -> do+ conds <- v .: "or"+ if null conds+ then fail "The 'or' condition requires at least one element"+ else pure (Or conds)+ "not" -> Not <$> v .: "not"+ "nf" -> NF <$> v .: "nf"+ "absolute" -> Absolute <$> v .: "absolute"+ "formation" -> IsFormation <$> v .: "formation"+ "disjoint" -> do+ vals <- v .: "disjoint"+ case vals of+ [attrs_, bds_] -> Disjoint <$> parseJSON attrs_ <*> parseJSON bds_+ _ -> fail "'disjoint' expects exactly two arguments"+ "eq" -> do+ vals <- v .: "eq"+ case vals of+ [left_, right_] -> Eq <$> parseJSON left_ <*> parseJSON right_+ _ -> fail "'eq' expects exactly two arguments"+ "gt" -> do+ vals <- v .: "gt"+ case vals of+ [left_, right_] -> Gt <$> parseJSON left_ <*> parseJSON right_+ _ -> fail "'gt' expects exactly two arguments"+ "in" -> do+ vals <- v .: "in"+ case vals of+ [attr_, binding_] -> In <$> parseJSON attr_ <*> parseJSON binding_+ _ -> fail "'in' expects exactly two arguments"+ "matches" -> do+ vals <- v .: "matches"+ case vals of+ [pat, ex] -> Matches <$> parseJSON pat <*> parseJSON ex+ _ -> fail "'matches' expects exactly two arguments"+ "part-of" -> do+ vals <- v .: "part-of"+ case vals of+ [ex, bd] -> PartOf <$> parseJSON ex <*> parseJSON bd+ _ -> fail "'part-of' expects exactly two arguments"+ _ -> fail "Unknown condition type"+ _ -> fail "Exactly one condition type is expected" instance FromJSON ExtraArgument where parseJSON v =
test/BuilderSpec.hs view
@@ -246,3 +246,10 @@ buildBinding (BiMeta "B") (substSingle "B" (MvBindings [BiVoid AtRho, BiVoid AtRho])) `shouldSatisfy` isLeft it "build formation with duplicates" $ buildExpression (ExMeta "e") (substSingle "e" (MvExpression (ExFormation [BiVoid AtRho, BiVoid AtRho]))) `shouldSatisfy` isLeft++ describe "buildExpression" $+ it "does not leave an invalid global application around rho" $+ buildExpression+ (ExApplication ExRoot (ArTau AtRho (ExFormation [BiVoid AtRho])))+ substEmpty+ `shouldBe` Right ExRoot
test/FilesSpec.hs view
@@ -13,6 +13,7 @@ import Files (FsException (..), allPathsIn, ensuredFile, overwrite) import System.Directory ( createDirectoryIfMissing+ , createDirectoryLink , executable , getPermissions , getTemporaryDirectory@@ -92,6 +93,18 @@ it "returns an empty list for an empty directory" $ withScratchDir $ \dir -> do paths <- allPathsIn dir paths `shouldBe` []++ it "does not follow symbolic links to directories" $ withScratchDir $ \dir -> do+ let nested = dir </> "nested"+ link = nested </> "back"+ createDirectoryIfMissing True nested+ writeFile (dir </> "top.txt") "top"+ if os == "mingw32"+ then pendingWith "Windows does not create directory symbolic links without elevated privileges"+ else do+ createDirectoryLink ".." link+ paths <- allPathsIn dir+ sort paths `shouldBe` [dir </> "top.txt"] describe "FsException" $ do forM_
test/LambdasSpec.hs view
@@ -138,6 +138,11 @@ , ("an entry with no answer at all", "- λ: L_pair\n", "cannot be read") , ("an entry whose answer is no term of the calculus", "- λ: L_pair\n 𝑛: ⟦ λ ⤍\n", "cannot be read") , ("two entries under one key", entry "L_pair" <> entry "L_pair", "is used by more than one entry")+ ,+ ( "two entries with overlapping regular expressions"+ , entry "L_(foo|bar)" <> entry "L_foo"+ , "match some of the same lambda names"+ ) , ("a key which is no regular expression", entry "L_[pair", "is not a regular expression") , ("an operand of 'dataize' which is no bytes meta", "- λ: L_pair\n dataize:\n 𝑛1: $.x\n 𝑛: ⟦ λ ⤍ 𝜎 ⟧\n", "is not a bytes meta") , ("an operand of 'morph' which is no expression meta", "- λ: L_pair\n morph:\n 𝛿1: $.x\n 𝑛: ⟦ λ ⤍ 𝜎 ⟧\n", "is not an expression meta")
test/RegexpSpec.hs view
@@ -77,6 +77,12 @@ , ("substitutes multiple groups", "$1-$2", ["full", "a", "b"], "a-b") , ("keeps dollar sign when no digits follow", "$ test", ["x"], "$ test") , ("keeps original reference for out of bounds index", "$9", ["only"], "$9")+ ,+ ( "keeps an oversized group reference literal"+ , "$999999999999999999999999999999999999999999"+ , ["only"]+ , "$999999999999999999999999999999999999999999"+ ) , ("handles replacement without group references", "plain", ["x"], "plain") , ("handles empty replacement", "", ["x"], "") , ("handles empty groups list with reference", "$0", [], "$0")@@ -128,6 +134,7 @@ , ("handles word boundary", "\\bword\\b", "WORD", "word in a word", "WORD in a WORD") , ("terminates on an empty-match pattern (anchored ^)", "^", "X", "hello", "XhXeXlXlXoX") , ("terminates on an empty regex pattern", "", "X", "hello", "XhXeXlXlXoX")+ , ("keeps UTF-8 characters together after an empty match", "(?=.)", "X", "é", "Xé") ] ( \(desc, pattern, replacement, input, expected) -> it desc $ do regex <- R.compile (B.pack pattern)
test/XMIRSpec.hs view
@@ -233,6 +233,15 @@ expr <- xmirToPhi doc parseExpressionThrows (printExpression expr) `shouldReturn` expr + describe "atom result types in XMIR" $+ it "survives a round trip through a λ marker" $ do+ doc <- parseXMIRThrows "<object><o name=\"bar\"><o base=\"∅\" name=\"x\"/><o atom=\"Φ.number\" name=\"λ\"/></o></object>"+ expr <- xmirToPhi doc+ result <- expressionToXMIR expr defaultXmirContext+ let printed = printXMIR result+ printed `shouldContain` "atom=\"Φ.number\""+ printed `shouldNotContain` "<o name=\"λ\">"+ describe "--hide-rho in XMIR" $ it "drops every bound ρ from the printed document" $ do expr <- parseExpressionThrows "[[ x -> 4, ^ -> [[ y -> 5 ]] ]]"@@ -373,6 +382,13 @@ expr <- parseExpressionThrows "[[ x -> \"foo\" ]]" xmir' <- expressionToXMIR expr commentedContext printXMIR xmir' `shouldContain` "<!-- \"foo\" -->"++ it "keeps text on both sides of a comment inside an object" $ do+ split <- parseXMIRThrows "<object><o name=\"x\">foo<!-- note -->bar</o></object>"+ joined <- parseXMIRThrows "<object><o name=\"x\">foobar</o></object>"+ actual <- xmirToPhi split+ expected <- xmirToPhi joined+ actual `shouldBe` expected describe "XMIR printing edge cases" $ do it "wraps a chained dispatch on a formation literal with a @base attribute" $ do
test/YamlSpec.hs view
@@ -247,19 +247,15 @@ Right _ -> expectationFailure "expected decoding to fail" describe "rejects a condition whose arguments count is wrong" $- -- 'asum' discards each branch's specific failure message once every- -- branch has failed, so only the overall Left/Right outcome (not the- -- message text) is observable from here; each case still exercises the- -- condition's own "expects exactly two arguments" guard internally. forM_- [ ("'eq' with a single argument", "eq: [1]")- , ("'gt' with a single argument", "gt: [1]")- , ("'in' with a single argument", "in: ['!t']")- , ("'matches' with a single argument", "matches: ['hi']")- , ("'part-of' with a single argument", "part-of: ['!e']")- , ("'disjoint' with a single argument", "disjoint: [[]]")+ [ ("'eq' with a single argument", "eq: [1]", "'eq' expects exactly two arguments")+ , ("'gt' with a single argument", "gt: [1]", "'gt' expects exactly two arguments")+ , ("'in' with a single argument", "in: ['!t']", "'in' expects exactly two arguments")+ , ("'matches' with a single argument", "matches: ['hi']", "'matches' expects exactly two arguments")+ , ("'part-of' with a single argument", "part-of: ['!e']", "'part-of' expects exactly two arguments")+ , ("'disjoint' with a single argument", "disjoint: [[]]", "'disjoint' expects exactly two arguments") ]- (\(desc, yaml) -> it desc ((decodeYaml' yaml :: Either Yaml.ParseException Condition) `shouldSatisfy` isLeft))+ (\(desc, yaml, message) -> it desc ((decodeYaml' yaml :: Either Yaml.ParseException Condition) `shouldSatisfy` failsWith message)) describe "rejects a malformed premise" $ forM_