diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,9 @@ # dickinson +## 1.4.2.0 + + * Export `pipelineBSLErr` + ## 1.4.1.2 * Performance improvements in the pattern match exhaustiveness checker diff --git a/doc/user-guide.pdf b/doc/user-guide.pdf Binary files a/doc/user-guide.pdf and b/doc/user-guide.pdf differ diff --git a/examples/divinationBot.dck b/examples/divinationBot.dck --- a/examples/divinationBot.dck +++ b/examples/divinationBot.dck @@ -33,6 +33,7 @@ | Bones | Land | Nails + | Entrails (:def prefix (:lambda x means @@ -65,7 +66,8 @@ [Teeth "odonto"] [Bones "osteo"] [Land "topo"] - [Nails "onycho"]))) + [Nails "onycho"] + [Entrails "haru"]))) (:def english (:lambda x means @@ -98,7 +100,8 @@ [Teeth "teeth"] [Bones "bones"] [Land "landforms"] - [Nails "fingernails"]))) + [Nails "fingernails"] + [Entrails "entrails"]))) (:def mod (:branch @@ -108,6 +111,7 @@ (| 0.3 "means of "))) (:def means + ; :pick refers to a type (:pick means)) (:def postfix diff --git a/language-dickinson.cabal b/language-dickinson.cabal --- a/language-dickinson.cabal +++ b/language-dickinson.cabal @@ -1,6 +1,6 @@ cabal-version: 2.0 name: language-dickinson -version: 1.4.1.2 +version: 1.4.2.0 license: BSD3 license-file: LICENSE copyright: Copyright: (c) 2020 Vanessa McHale @@ -8,7 +8,7 @@ author: Vanessa McHale tested-with: ghc ==8.0.2 ghc ==8.2.2 ghc ==8.4.4 ghc ==8.6.5 ghc ==8.8.4 - ghc ==8.10.2 + ghc ==8.10.7 ghc ==9.0.2 ghc ==9.2.2 synopsis: A language for generative literature description: Dickinson is a language for generative (random) literature @@ -57,7 +57,7 @@ ghc-options: -Wall build-depends: base >=4.9 && <5, - dickinson -any + dickinson if !flag(cross) exposed-modules: Language.Dickinson.TH @@ -67,8 +67,8 @@ if !flag(cross) build-depends: - template-haskell -any, - text -any + template-haskell, + text if impl(ghc >=8.0) ghc-options: @@ -132,28 +132,28 @@ ghc-options: -Wall -O2 -fstatic-argument-transformation build-depends: base >=4.9 && <5, - array -any, - bytestring -any, + array, + bytestring, text >=1.0.0.0, - mtl -any, - transformers -any, - containers -any, - random -any, + mtl, + transformers, + containers, + random, prettyprinter >=1.7.0, - deepseq -any, - microlens -any, - microlens-mtl -any, + deepseq, + microlens, + microlens-mtl, composition-prelude >=2.0.0.0, binary >=0.8.4.0, - filepath -any, - directory -any, - split -any + filepath, + directory, + split if !flag(cross) - build-tool-depends: alex:alex -any, happy:happy -any + build-tool-depends: alex:alex, happy:happy if !impl(ghc >=8.0) - build-depends: semigroups -any + build-depends: semigroups if impl(ghc >=8.0) ghc-options: @@ -186,29 +186,29 @@ -Wall -rtsopts -with-rtsopts=-A4M -fstatic-argument-transformation build-depends: - base -any, - dickinson -any, - optparse-applicative -any, - bytestring -any, - prettyprinter -any, - text -any, + base, + dickinson, + optparse-applicative, + bytestring, + prettyprinter, + text, haskeline >=0.8, - mtl -any, - random -any, - microlens-mtl -any, - microlens -any, - containers -any, - filepath -any, - directory -any, - language-dickinson -any, - binary -any + mtl, + random, + microlens-mtl, + microlens, + containers, + filepath, + directory, + language-dickinson, + binary if !flag(cross) - build-tool-depends: cpphs:cpphs -any + build-tool-depends: cpphs:cpphs if flag(zstd) cpp-options: -DZSTD - build-depends: zstd -any + build-depends: zstd if impl(ghc >=8.0) ghc-options: @@ -231,7 +231,6 @@ other-modules: Eval Golden - Pattern Roundtrip.Compare TypeCheck TH @@ -240,17 +239,17 @@ other-extensions: OverloadedStrings TemplateHaskell ghc-options: -threaded -rtsopts "-with-rtsopts=-N -K1K" -Wall build-depends: - base -any, - dickinson -any, - tasty -any, - tasty-hunit -any, - bytestring -any, - prettyprinter -any, - text -any, - filepath -any, - tasty-golden -any, + base, + dickinson, + tasty, + tasty-hunit, + bytestring, + prettyprinter, + text, + filepath, + tasty-golden, pretty-simple >=4.0.0.0, - language-dickinson -any + language-dickinson if impl(ghc >=8.0) ghc-options: @@ -275,12 +274,12 @@ -Wall -rtsopts -with-rtsopts=-A4M -fstatic-argument-transformation build-depends: - base -any, - dickinson -any, - binary -any, - criterion -any, - bytestring -any, - text -any + base, + dickinson, + binary, + criterion, + bytestring, + text if impl(ghc >=8.0) ghc-options: diff --git a/lib/adjectives.dck b/lib/adjectives.dck --- a/lib/adjectives.dck +++ b/lib/adjectives.dck @@ -11,13 +11,31 @@ (| color) (| "sententious") (| "hylic") + (| "ostensive") (| "poetic") (| "limpid") (| "plain") + (| "phatic") + (| "spavined") + (| "pert") + (| "mickle") (| "splenetic") + (| "mawkish") + (| "sedulously") + (| "saudade") + (| "fractious") + (| "fugacious") + (| "noisome") + (| "baneful") + (| "auxetic") (| "bromide") + (| "murine") (| "banal") (| "redolent") + (| "eutectic") + (| "autochthonous") + (| "poncy") + (| "bammy") (| "aposematic") (| "artful") (| "anabatic") @@ -25,8 +43,10 @@ (| "antinomian") (| "boffo") (| "azure") + (| "fousty") (| "antipruritic") (| "elysian") + (| "uxorious") (| "alveated") (| "prolix") (| "audacious") @@ -204,6 +224,7 @@ (| "irritable") (| "interior") (| "itchy") + (| "impecunious") (| "imperious") (| "ingratiating") (| "irrational") @@ -229,6 +250,7 @@ (| "kinky") (| "kind") (| "katharobic") + (| "orthodox") (| "scrobiculate") (| "stroppy") (| "salubrious") @@ -277,6 +299,7 @@ (| "nude") (| "noctilucent") (| "nocturnal") + (| "rhematic") (| "noetic") (| "noxious") (| "nosy") @@ -479,6 +502,7 @@ (| "xanthous") (| "xenophobic") (| "xeric") + (| "gelid") (| "xenodochial") (| "yonic") (| "yellow") @@ -492,5 +516,6 @@ (| "zealous") (| "zesty") (| "pithy") + (| "diaphanous") (| "orotund") (| "stentorian")))) diff --git a/lib/animal.dck b/lib/animal.dck --- a/lib/animal.dck +++ b/lib/animal.dck @@ -14,7 +14,7 @@ (| "fish") (| "shark") (| "frog") - (| "amphisbaenians") + (| "amphisbaenian") (| "caecilian") (| "alligator") (| "reptile") diff --git a/lib/clippy.dck b/lib/clippy.dck new file mode 100644 --- /dev/null +++ b/lib/clippy.dck @@ -0,0 +1,17 @@ +%- + +(:def clippy + (:lambda txt text + ''' + + ${txt} + __ + / \ + | | + @ @ + | | + || |/ + || || + |\_/| + \___/ + ''')) diff --git a/lib/fun/vierergruppe.dck b/lib/fun/vierergruppe.dck new file mode 100644 --- /dev/null +++ b/lib/fun/vierergruppe.dck @@ -0,0 +1,21 @@ +%- + +; Klein 4-group +tydecl element = E | A | B | C + +(:def mult + (:lambda x element + (:lambda y element + (:match (x, y) + [(E, x) x] + [(x, E) x] + [(A, A) E] + [(A, B) C] + [(A, C) B] + [(B, A) C] + [(B, B) E] + [(B, C) A] + [(C, A) B] + [(C, B) A] + [(C, C) E] + )))) diff --git a/lib/noun.dck b/lib/noun.dck --- a/lib/noun.dck +++ b/lib/noun.dck @@ -3,22 +3,47 @@ %- +; see: http://rhetoric.byu.edu/default.htm (:def rhetoricalDevice (:oneof (| "stichomythia") (| "antanaclasis") (| "metaphor") (| "metabole") + (| "acedia") (| "antimetabole") (| "adnomination") (| "anaphora") + (| "ichthus") + (| "metalepsis") + (| "kenning") + (| "bolete") + (| "sough") + (| "parataxis") + (| "algolagnia") + (| "scansion") (| "assonance") + (| "sabbing") + (| "adynaton") + (| "aposiopesis") + (| "pilcrow") (| "asyndeton") + (| "wean") + (| "consilience") + (| "wimple") + (| "bower") + (| "histology") + (| "croft") + (| "scran") (| "polysyndeton") (| "sarcasm") + (| "therianthropy") (| "litotes") + (| "chiasmus") + (| "isocolon") (| "understatement") (| "irony") + (| "afflatus") (| "paradox") (| "hyperbole") (| "epizeuxis") @@ -27,12 +52,29 @@ (| "simile") (| "alliteration") (| "synecdoche") + (| "catachresis") + (| "guff") + (| "anapodoton") + (| "anacoluthon") + (| "anadiplosis") + (| "meiosis") + (| "tapinosis") + (| "auxesis") + (| "cacemphaton") + (| "epanalepsis") + (| "antonomasia") + (| "paroemion") + (| "homoeoprophoron") + (| "cacozelia") + (| "soraismus") + (| "bahuvrihi") (| "zeugma") (| "metonymy"))) (:def nounPhrase (:oneof (| "sheela na gig") + (| "barn burner") (| "roach clip"))) (:def subjectDiscipline @@ -49,21 +91,47 @@ (| subjectDiscipline) (| "valetudinarian") (| "car") + (| "ichor") + (| "tret") + (| "heteroglossia") + (| "coenesthesia") + (| "flagellant") + (| "withe") + (| "solecism") + (| "hyperdulia") + (| "sillage") + (| "propinquity") + (| "elegy") + (| "eulogy") + (| "coterie") + (| "volvelle") + (| "alacrity") + (| "yoke") (| "head") (| "punnet") + (| "orthopraxy") (| "sitophobia") (| "acedia") + (| "spandrel") (| "tail") + (| "bredrin") + (| "apse") (| "joke") (| "autocracy") + (| "caloyer") (| "foofaraw") (| "supererogation") (| "autonomous") (| "pseudonym") + (| "exegete") + (| "frisson") (| "perfidy") (| "potboiler") (| "heliophagy") + (| "alterity") (| "poultice") + (| "quiescence") + (| "gemish") (| "aril") (| "valedictorian") (| "cathexis") @@ -72,8 +140,11 @@ (| "pyxis") (| "salp") (| "kayfabe") + (| "stope") (| "pablum") + (| "pastille") (| "satori") + (| "catechumen") (| "ardor") (| "palaver") (| "theogeny") @@ -85,6 +156,7 @@ (| "bindle") (| "rhotacism") (| "doyenne") + (| "coof") (| "theurgy") (| "ulzzang") (| "locum") @@ -100,6 +172,7 @@ (| "colophon") (| "belvedere") (| "dilatation") + (| "blagging") (| "clyster") (| "apocarteresis") (| "kyphosis") @@ -138,7 +211,6 @@ (| "bilocation") (| "apricity") (| "ambo") - (| "frisson") (| "prosody") (| "limner") (| "kenjataimu") @@ -223,6 +295,7 @@ (| "infelicity") (| "hoplophile") (| "gloaming") + (| "vitriolage") (| "lexer") (| "parser") (| "generator") @@ -343,4 +416,7 @@ (| "bevel") (| "thurible") (| "perihelion") + (| "cabochon") + (| "sortition") + (| "weft") (| "folderol")))) diff --git a/lib/verb.dck b/lib/verb.dck new file mode 100644 --- /dev/null +++ b/lib/verb.dck @@ -0,0 +1,13 @@ +(:include grammar.verb) + +%- + +(:def verb + (:oneof + (| "trundle") + (| "loll") + (| "avulse") + (| "plotz") + (| "subluxate") + (| "remonstrate") + (| "boke"))) diff --git a/man/emd.1 b/man/emd.1 --- a/man/emd.1 +++ b/man/emd.1 @@ -1,5 +1,19 @@ -.\" Automatically generated by Pandoc 2.11.1 +.\" Automatically generated by Pandoc 2.18 .\" +.\" Define V font for inline verbatim, using C font in formats +.\" that render this, and otherwise B font. +.ie "\f[CB]x\f[]"x" \{\ +. ftr V B +. ftr VI BI +. ftr VB B +. ftr VBI BI +.\} +.el \{\ +. ftr V CR +. ftr VI CI +. ftr VB CB +. ftr VBI CBI +.\} .TH "emd (1)" "" "" "" "" .hy .SH NAME @@ -21,7 +35,7 @@ man $(emd man) .SS SHEBANG .PP -Dickinson ignores lines starting with \f[C]#!\f[R] so we can put +Dickinson ignores lines starting with \f[V]#!\f[R] so we can put .IP .nf \f[C] @@ -29,7 +43,7 @@ \f[R] .fi .PP -at the top of a file and \f[C]emd\f[R] will be used as an interpreter. +at the top of a file and \f[V]emd\f[R] will be used as an interpreter. .SH SUBCOMMANDS .PP \f[B]repl\f[R] - Start a repl @@ -72,7 +86,7 @@ Directory to search for libraries .SH INFLUENTIAL ENVIRONMENT VARIABLES .PP -\f[C]DCK_PATH\f[R] - a colon-separated list of directories to search +\f[V]DCK_PATH\f[R] - a colon-separated list of directories to search .SH EDITOR INTEGRATION .PP A vim plugin is available; see @@ -102,14 +116,14 @@ \f[R] .fi .PP -Put this in your \f[C]\[ti]/.bashrc\f[R] or -\f[C]\[ti]/.bash_profile\f[R] to install them. +Put this in your \f[V]\[ti]/.bashrc\f[R] or +\f[V]\[ti]/.bash_profile\f[R] to install them. .PP Shell completions are also available for fish and zsh; to get them: .PP -\f[C]emd --fish-completion-script emd\f[R] +\f[V]emd --fish-completion-script emd\f[R] .PP -\f[C]emd --zsh-completion-script emd\f[R] +\f[V]emd --zsh-completion-script emd\f[R] .SH BUGS .PP Please report any bugs you may come across to diff --git a/public/Language/Dickinson.hs b/public/Language/Dickinson.hs --- a/public/Language/Dickinson.hs +++ b/public/Language/Dickinson.hs @@ -22,6 +22,7 @@ , resolveImport -- * Evaluation , pipelineBSL + , pipelineBSLErr , validateBSL , patternExhaustivenessBSL , warnBSL diff --git a/src/Language/Dickinson/File.hs b/src/Language/Dickinson/File.hs --- a/src/Language/Dickinson/File.hs +++ b/src/Language/Dickinson/File.hs @@ -15,6 +15,7 @@ , amalgamateRenameM , pipeline , pipelineBSL + , pipelineBSLErr , resolveFile ) where @@ -26,9 +27,11 @@ import Control.Monad.Except (ExceptT, MonadError, runExceptT) import Control.Monad.IO.Class (MonadIO) import Control.Monad.State (MonadState, StateT, evalStateT) +import Data.Bifunctor (first) import qualified Data.ByteString.Lazy as BSL import Data.Functor (($>)) import Data.Text as T +import Data.Text.Prettyprint.Doc.Ext (prettyText) import Language.Dickinson.Check import Language.Dickinson.Check.Duplicate import Language.Dickinson.Check.Exhaustive @@ -42,6 +45,7 @@ import Language.Dickinson.Rename.Amalgamate import Language.Dickinson.Type import Language.Dickinson.TypeCheck +import Prettyprinter (pretty) import System.Random (StdGen, newStdGen, randoms) data AmalgamateSt = AmalgamateSt { amalgamateRenames :: Renames @@ -157,6 +161,14 @@ pipeline :: [FilePath] -> FilePath -> IO T.Text pipeline is fp = fmap eitherThrow $ evalIO $ checkEvalM =<< amalgamateRenameM is fp + +-- | @since 1.4.2.0 +pipelineBSLErr :: [FilePath] + -> FilePath -- ^ For error reporting + -> BSL.ByteString + -> IO (Either T.Text T.Text) +pipelineBSLErr is fp bsl = fmap (first prettyText) $ evalIO $ + checkEvalM =<< amalgamateRenameInpM is fp bsl -- | @since 1.4.1.0 pipelineBSL :: [FilePath] diff --git a/src/Language/Dickinson/Rename.hs b/src/Language/Dickinson/Rename.hs --- a/src/Language/Dickinson/Rename.hs +++ b/src/Language/Dickinson/Rename.hs @@ -24,7 +24,6 @@ import Data.Binary (Binary) import qualified Data.IntMap as IM import qualified Data.List.NonEmpty as NE -import Data.Semigroup (Semigroup (..)) import Data.Text.Prettyprint.Doc.Ext import GHC.Generics (Generic) import Language.Dickinson.Name @@ -54,19 +53,12 @@ instance HasRenames Renames where rename = id -instance Semigroup Renames where - (<>) (Renames m1 b1) (Renames m2 b2) = Renames (max m1 m2) (b1 <> b2) - -instance Monoid Renames where - mempty = Renames 0 mempty - mappend = (<>) - -type RenameM a = State Renames +type RenameM = State Renames initRenames :: Renames initRenames = Renames 0 mempty -runRenameM :: Int -> RenameM a x -> (x, UniqueCtx) +runRenameM :: Int -> RenameM x -> (x, UniqueCtx) runRenameM i x = second max_ (runState x (Renames i mempty)) -- Make sure you don't have cycles in the renames map! diff --git a/test/Pattern.hs b/test/Pattern.hs deleted file mode 100644 --- a/test/Pattern.hs +++ /dev/null @@ -1,36 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Pattern ( patternTests - ) where - -import Data.List.NonEmpty (NonEmpty (..)) -import Language.Dickinson.Name -import Language.Dickinson.Pattern.Useless -import Language.Dickinson.Type -import Language.Dickinson.Unique -import Test.Tasty -import Test.Tasty.HUnit - -patternTests :: TestTree -patternTests = testGroup "Pattern match unit tests" - [ testSpecializeTuple - , testSpecializeTag - ] - --- just tests that they make sense as I understand them -testSpecializeTuple :: TestTree -testSpecializeTuple = testCase "specializeTuple" $ do - let patternMatrix = [[Wildcard ()]] - specializedMatrix = specializeTuple 2 patternMatrix - specializedMatrix @?= [[Wildcard (), Wildcard ()]] - -testSpecializeTag :: TestTree -testSpecializeTag = testCase "specializeTag" $ do - let n0 = Name ("a0" :| []) (Unique 0) () - n1 = Name ("a1" :| []) (Unique 1) () - patternMatrix = [ [PatternCons () n0, Wildcard ()] - , [PatternCons () n1, Wildcard ()] - ] - specializedMatrix = [ [Wildcard ()] - ] - specializeTag n0 patternMatrix @?= specializedMatrix diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -2,31 +2,25 @@ module Main (main) where -import Control.Exception.Value (eitherThrow) -import qualified Data.ByteString.Lazy as BSL -import Data.Either (isRight) -import Data.List.NonEmpty (NonEmpty (..)) -import Data.Maybe (isJust, isNothing) +import Control.Exception.Value (eitherThrow) +import qualified Data.ByteString.Lazy as BSL +import Data.Either (isRight) +import Data.List.NonEmpty (NonEmpty (..)) +import Data.Maybe (isJust) import Eval import Golden -import Language.Dickinson.Check import Language.Dickinson.Check.Duplicate -import Language.Dickinson.Check.Exhaustive import Language.Dickinson.Check.Internal -import Language.Dickinson.Check.Pattern -import Language.Dickinson.Check.Scope import Language.Dickinson.File import Language.Dickinson.Import import Language.Dickinson.Lexer import Language.Dickinson.Name import Language.Dickinson.Parser -import Language.Dickinson.Rename import Language.Dickinson.Type import Language.Dickinson.Unique -import Pattern +import TH import Test.Tasty import Test.Tasty.HUnit -import TH import TypeCheck main :: IO () @@ -37,44 +31,23 @@ , parserTests , evalTests , tcTests - , patternTests ] parserTests :: TestTree parserTests = testGroup "Parser tests" - [ lexNoError "test/data/let.dck" - , parseNoError "test/data/const.dck" + [ parseNoError "test/data/const.dck" , parseNoError "test/data/let.dck" , parseNoError "test/data/nestLet.dck" , parseNoError "lib/color.dck" , parseNoError "lib/birds.dck" - , lexNoError "test/data/import.dck" - , lexNoError "test/data/lexDollarSign.dck" , parseNoError "test/data/import.dck" - , detectDuplicate "test/data/multiple.dck" - , detectDuplicate "test/error/double.dck" - , detectDuplicate "test/error/tyDouble.dck" - , detectDuplicate "test/error/tyConsDouble.dck" - , lexNoError "examples/shakespeare.dck" - , lexNoError "test/data/multiStr.dck" , parseNoError "test/data/multiStr.dck" , parseNoError "examples/shakespeare.dck" - , detectScopeError "test/demo/improbableScope.dck" , detectBadBranch "test/demo/sillyOption.dck" - , noScopeError "test/demo/circular.dck" - , noScopeError "test/data/adt.dck" - , detectScopeError "test/error/tyScope.dck" - , detectScopeError "test/error/constructorScope.dck" - , lexNoError "test/data/multiQuoteify.dck" , parseNoError "test/data/multiQuoteify.dck" , findPath , sanityCheckTest "test/data/adt.dck" - , detectSuspiciousPattern "test/error/badMatch.dck" - , detectBadPattern "test/demo/inexhaustive.dck" - , noInexhaustive "test/demo/exhaustive.dck" - , detectBadPattern "test/error/inexhaustivePatternMatch.dck" - , noInexhaustive "prelude/curry.dck" , thTests ] @@ -91,56 +64,14 @@ (Dickinson _ parsed) <- readNoFail fp assertBool fp $ isJust (checkDuplicates parsed) -detectDuplicate :: FilePath -> TestTree -detectDuplicate fp = testCase ("Detects duplicate name (" ++ fp ++ ")") $ do - (Dickinson _ parsed) <- readNoFail fp - assertBool fp $ isJust (checkMultiple parsed) - -detectSuspiciousPattern :: FilePath -> TestTree -detectSuspiciousPattern fp = testCase fp $ do - (Dickinson _ parsed) <- readNoFail fp - assertBool fp $ isJust (checkPatternDecl parsed) - -detectScopeError :: FilePath -> TestTree -detectScopeError fp = testCase "Finds scoping error" $ do - (Dickinson _ renamed) <- parseRename fp - assertBool fp $ isJust (checkScope renamed) - -noScopeError :: FilePath -> TestTree -noScopeError fp = testCase "Reports valid scoping" $ do - (Dickinson _ renamed) <- parseRename fp - assertBool fp $ isNothing (checkScope renamed) - parseNoError :: FilePath -> TestTree parseNoError fp = testCase ("Parsing doesn't fail (" ++ fp ++ ")") $ do contents <- BSL.readFile fp assertBool "Doesn't fail parsing" $ isRight (parse contents) -lexNoError :: FilePath -> TestTree -lexNoError fp = testCase ("Lexing doesn't fail (" ++ fp ++ ")") $ do - contents <- BSL.readFile fp - assertBool "Doesn't fail lexing" $ isRight (lexDickinson contents) - -parseRename :: FilePath -> IO (Dickinson AlexPosn) -parseRename = fmap (fst . uncurry renameDickinson . eitherThrow . parseWithMax) . BSL.readFile - -- sanity check the renamer sanityCheckTest :: FilePath -> TestTree sanityCheckTest fp = testCase fp $ fmap eitherThrow $ evalIO $ do ds <- amalgamateRenameM [] fp sanityCheck ds - -noInexhaustive :: FilePath -> TestTree -noInexhaustive fp = testCase "Reports non-sketchy pattern matches" $ do - (Dickinson _ ds) <- parseNoRename fp - assertBool fp $ isNothing (checkExhaustive ds) - -detectBadPattern :: FilePath -> TestTree -detectBadPattern fp = testCase "Detects sketchy pattern match" $ do - (Dickinson _ ds) <- parseNoRename fp - assertBool fp $ isJust (checkExhaustive ds) - - -parseNoRename :: FilePath -> IO (Dickinson AlexPosn) -parseNoRename = fmap (eitherThrow . parse) . BSL.readFile