oughta (empty) → 0.1.0.0

raw patch · 32 files changed

+1460/−0 lines, 32 filesdep +basedep +bytestringdep +containers

Dependencies added: base, bytestring, containers, directory, exceptions, file-embed, filepath, hslua, oughta, tasty, tasty-hunit, text

Files

• CHANGELOG.md +5/−0
• LICENSE +30/−0
• README.md +249/−0
• oughta.cabal +168/−0
• src/Oughta.hs +57/−0
• src/Oughta/Exception.hs +73/−0
• src/Oughta/Extract.hs +99/−0
• src/Oughta/Lua.hs +11/−0
• src/Oughta/LuaApi.hs +182/−0
• src/Oughta/Pos.hs +76/−0
• src/Oughta/Result.hs +154/−0
• src/Oughta/Traceback.hs +99/−0
• src/Oughta/oughta.lua +31/−0
• test-data/fail/check.txt +26/−0
• test-data/fail/here.txt +5/−0
• test-data/pass/check-empty.txt +2/−0
• test-data/pass/check-immediate.txt +4/−0
• test-data/pass/check.txt +19/−0
• test-data/pass/file.txt +3/−0
• test-data/pass/for.txt +7/−0
• test-data/pass/function.txt +11/−0
• test-data/pass/here.txt +9/−0
• test-data/pass/hereln.txt +9/−0
• test-data/pass/line.txt +4/−0
• test-data/pass/prelude.txt +3/−0
• test-data/pass/source-map.txt +10/−0
• test-data/pass/src-line.txt +7/−0
• test-data/pass/text.txt +3/−0
• test-data/pass/unicode.txt +4/−0
• test-data/pass/var.txt +8/−0
• test/Test.hs +74/−0
• test/test.lua +18/−0

@@ -0,0 +1,5 @@+# [0.1.0.0] -- 2025-04-22++[0.1.0.0]: https://github.com/GaloisInc/oughta/releases/tag/v0.1.0.0++Initial release.

@@ -0,0 +1,30 @@+Copyright (c) 2025 Galois Inc.+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:++  * Redistributions of source code must retain the above copyright+    notice, this list of conditions and the following disclaimer.++  * Redistributions in binary form must reproduce the above copyright+    notice, this list of conditions and the following disclaimer in+    the documentation and/or other materials provided with the+    distribution.++  * Neither the name of Galois, Inc. nor the names of its contributors+    may be used to endorse or promote products derived from this+    software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS+IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED+TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A+PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER+OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,+EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,+PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR+PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF+LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING+NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,249 @@+# Oughta++Oughta is a Haskell library for testing programs that output text. The testing+paradigm essentially combines golden testing with `grep`.++More precisely, Oughta provides a DSL to build *recognizers* (i.e., parsers that+simply accept or reject an string). The inputs to Oughta are a string (usually,+the output of the program under test) and a separate, generally quite short+program written in the Oughta DSL.++The simplest DSL procedure is `check`, which checks that the output contains a+string. For example, the following test would pass:++Program output:+```+Hello, world!+```+DSL program:+```+check "Hello"+check "world"+```++Oughta draws inspiration from LLVM's [FileCheck] and Rust's [compiletest].++[FileCheck]: https://llvm.org/docs/CommandGuide/FileCheck.html+[compiletest]: https://rustc-dev-guide.rust-lang.org/tests/compiletest.html++## Example++Let's say that you have decided to write the first ever Haskell implementation+of a POSIX shell, `hsh`. Here's how to test it with Oughta.++If the input to the program under test is a file format that supports comments,+it is often convenient to embed Oughta DSL programs in the input itself. For+example, here's a test for `echo`:++```sh+# check "Hello, world!"+echo 'Hello, world!'+```++Using this strategy, each test case is a single file. You can use the+`directory` package to discover tests from a directory, and `tasty{,-hunit}` to+run tests:++```haskell+module Main (main) where++import Control.Monad (filterM, forM)+import Data.ByteString qualified as BS+import Oughta qualified+import System.Directory qualified as Dir+import Test.Tasty qualified as TT+import Test.Tasty.HUnit qualified as TTH++-- Code under test:+-- runScript :: ByteString -> (ByteString, ByteString)+-- Returns (stdout, stderr)+import Hsh (runScript)++test :: FilePath -> IO ()+test sh = do+  content <- BS.readFile sh+  (stdout, _stderr) <- runScript content+  let comment = "# "  -- shell script start-of-line comment+  let prog = Oughta.fromLineComments sh comment content+  Oughta.check' prog (Oughta.Output stdout)++main :: IO ()+main = do+  let dir = "test-data/"+  entries <- map (dir </>) <$> Dir.listDirectory dir+  files <- filterM Dir.doesFileExist entries+  let shs = List.filter ((== ".sh") . FilePath.takeExtension) files+  let mkTest path = TTH.testCase path (test path)+  let tests = map mkTest shs+  TT.defaultMain (TT.testGroup "hsh tests" tests)+```++Now you can just toss `.sh` scripts into `test-data/` and have them picked up+as tests.++What if you wanted to test both stdout and stderr? You can use two different+styles of comments:+```haskell+test :: FilePath -> IO ()+test sh = do+  -- snip --+  let stdoutComment = "# STDOUT: "+  let prog = Oughta.fromLineComments sh stdoutComment content+  Oughta.check' prog (Oughta.Output stdout)++  let stderrComment = "# STDERR: "+  let prog' = Oughta.fromLineComments sh stderrComment content+  Oughta.check' prog' (Oughta.Output stderr)+```++Test cases would then look like so:++```sh+# STDOUT: check "Hello, stdout!"+echo 'Hello, stdout!'+# STDERR: check "Hello, stderr!"+echo 'Hello, stderr!' 1>&2+```++## Cookbook++This section demonstrates how to accomplish common tasks with the Oughta DSL.+The DSL is just [Lua][lua], extended with an API for easy parsing.++[Lua]: https://www.lua.org/++Writing tests in Lua offers considerable flexibility and expressive power.+However, with great power comes with great responsibility. Tests should be+as simple as possible, and some repetition should be accepted for the sake of+readability. It is often appropriate to just make a sequence of API calls with+literal strings as arguments.++Oughta is used to test itself. See the test suite for additional examples.++### Long matches++Match large blocks of text with Lua's multi-line string syntax:+```+some+multi-line+    text+```+```lua+check [[+some+multi-line+    text+]]+```++### Repetition++Match repetitive text using a variable:++```+HAL: Affirmative, Dave. I read you.+Dave: Open the pod bay doors, HAL.+HAL: I'm sorry, Dave. I'm afraid I can't do that.+```+```lua+name="Dave"+check("Affirmative, " .. name)+check("I'm sorry, " .. name)+```+or with a `for`-loop:+```+Step 1: Learn about Oughta+Step 2: Use it to test your project+Step 3: Enjoy!+```+```lua+for i=1,3 do+  check("Step %d".format(i))+end+```++### Checking for generated text++To check that some dynamically-generated text appears elsewhere in the output,+use the `string` library and the `text` variable:+```+Generating a random number...+Generated 37106428!+Printing 37106428...+```+```lua+check "Generated "+num=string.find(text, "^%d+")+check(string.format("Printing %d...", num))+```++The above example borders on *too much* logic for a test case. Use discretion+when writing tests!++## API reference++The Lua API is *stateful*. It keeps track of a global variable `text` that+is initialized to the output of the program under test. Various API functions+cause the API to seek forward in `text`. This is analogous to working file-like+objects in languages like C or Python. `text` should not be updated from Lua+code; such updates will be ignored by Oughta.++### High-level API++Checking functions:++- `check(s: String)`: Find `s` in `text`. Seek to after the end of `s`. Like+  LLVM FileCheck's `CHECK`.+- `checkln(s: String)`: `checkln(s)` is equivalent to `check(s .. "\n")`.+- `here(s: String)`: Check that `text` beings with `s`. Seek to after the end+  of `s`.+- `hereln(String)`: `hereln(s)` is equivalent to `here(s .. "\n")`.++Other utilities:++- `col() -> Int`: Get the current line number of `text` in the output.+- `file() -> String`: Get the file name of the test case.+- `line() -> Int`: Get the current line number of `text` in the output.+- `src_line(n: Int) -> Int`: Get the line number of the Lua code at stack level+  `n`.++### Low-level API++- `fail()`: Fail to match at this point in `text`.+- `match(n: Integer)`: Consume `n` bytes of `text`, treating them as a match.+- `seek(n: Integer)`: Seek forward `n` bytes in `text`.++## Motivation++The overall Oughta paradigm is a form of [data driven testing]. See that blog+post for considerable motivation and discussion.++[data driven testing]: https://matklad.github.io/2021/05/31/how-to-test.html#Data-Driven-Testing++In comparison to golden testing, Oughta-style tests are *coarser*. They only+check particular parts of the program's output. This can cause less churn in+the test suite when the program output changes in ways that are not relevant+to the properties being tested. The fineness of golden testing can force+devlopers to adopt [complex] [workarounds], these can sometimes be obviated by+Oughta-style testing.++[complex]: https://rustc-dev-guide.rust-lang.org/tests/ui.html#normalization+[workarounds]: https://github.com/GaloisInc/crucible/blob/dc0895f4435dc19a8cceee3272c9a508221bce51/crux-llvm/test/Test.hs#L226-L311++However, it is more complex. For example, it requires learning the Oughta DSL.+It can also cause unexpected successes, e.g., if the program output contains the+pattern being checked, but not in the proper place.++Why build a Haskell library when LLVM already provides their FileCheck tool?+There are a variety of reasons:++1. Ease of adoption: external runtime test dependencies are painful+2. Speed: use as a library avoids file I/O, spawning shells, etc.+3. Flexibility: FileCheck can be used on tools without command-line interfaces++## Versioning policy++Oughta conforms to the [Haskell Package Versioning Policy][pvp]. Both the Lua+and Haskell APIs are considered to be part of the public interface.++[pvp]: https://pvp.haskell.org/

@@ -0,0 +1,168 @@+cabal-version: 2.4+name: oughta+version: 0.1.0.0+author: Galois, Inc.+maintainer: grease@galois.com+copyright: Galois, Inc. 2025+license: BSD-3-Clause+license-file: LICENSE+synopsis: A library to test programs that output text.+description:+  A library to test programs that output text.++  See the README for details.+extra-doc-files:+  README.md+  CHANGELOG.md+extra-source-files:+  src/Oughta/oughta.lua+  test-data/**/*.txt+  test/test.lua+category: Testing++source-repository head+  type: git+  location: https://github.com/GaloisInc/oughta++common shared+  default-language: GHC2021+  build-depends: base >= 4.19 && < 5++  -- Specifying -Wall and -Werror can cause the project to fail to build on+  -- newer versions of GHC simply due to new warnings being added to -Wall. To+  -- prevent this from happening we manually list which warnings should be+  -- considered errors. We also list some warnings that are not in -Wall, though+  -- try to avoid "opinionated" warnings (though this judgement is clearly+  -- subjective).+  --+  -- Warnings are grouped by the GHC version that introduced them, and then+  -- alphabetically.+  --+  -- A list of warnings and the GHC version in which they were introduced is+  -- available here:+  -- https://ghc.gitlab.haskell.org/ghc/doc/users_guide/using-warnings.html++  -- Since GHC 9.6 or earlier:+  ghc-options:+    -Wall+    -Werror=ambiguous-fields+    -Werror=deferred-type-errors+    -Werror=deprecated-flags+    -Werror=deprecations+    -Werror=deriving-defaults+    -Werror=deriving-typeable+    -Werror=dodgy-foreign-imports+    -Werror=duplicate-exports+    -Werror=empty-enumerations+    -Werror=gadt-mono-local-binds+    -Werror=identities+    -Werror=inaccessible-code+    -Werror=incomplete-patterns+    -Werror=incomplete-record-updates+    -Werror=incomplete-uni-patterns+    -Werror=inline-rule-shadowing+    -Werror=misplaced-pragmas+    -Werror=missed-extra-shared-lib+    -Werror=missing-exported-signatures+    -Werror=missing-fields+    -Werror=missing-home-modules+    -Werror=missing-methods+    -Werror=missing-pattern-synonym-signatures+    -Werror=missing-signatures+    -Werror=name-shadowing+    -Werror=noncanonical-monad-instances+    -Werror=noncanonical-monoid-instances+    -Werror=operator-whitespace+    -Werror=operator-whitespace-ext-conflict+    -Werror=orphans+    -Werror=overflowed-literals+    -Werror=overlapping-patterns+    -Werror=partial-fields+    -Werror=partial-type-signatures+    -Werror=redundant-bang-patterns+    -Werror=redundant-record-wildcards+    -Werror=redundant-strictness-flags+    -Werror=simplifiable-class-constraints+    -Werror=star-binder+    -Werror=star-is-type+    -Werror=tabs+    -Werror=type-defaults+    -Werror=typed-holes+    -Werror=type-equality-out-of-scope+    -Werror=type-equality-requires-operators+    -Werror=unicode-bidirectional-format-characters+    -Werror=unrecognised-pragmas+    -Werror=unrecognised-warning-flags+    -Werror=unsupported-calling-conventions+    -Werror=unsupported-llvm-version+    -Werror=unticked-promoted-constructors+    -Werror=unused-do-bind+    -Werror=unused-imports+    -Werror=unused-record-wildcards+    -Werror=warnings-deprecations+    -Werror=wrong-do-bind++  if impl(ghc < 9.8)+    ghc-options:+      -Werror=forall-identifier++  if impl(ghc < 9.12)+    ghc-options:+      -Werror=compat-unqualified-imports++  if impl(ghc >= 9.8)+    ghc-options:+      -Werror=incomplete-export-warnings+      -Werror=inconsistent-flags+      -Werror=missing-poly-kind-signatures++  if impl(ghc >= 9.10)+    ghc-options:+      -Werror=badly-staged-types+      -Werror=data-kinds-tc+      -Werror=deprecated-type-abstractions+      -Werror=incomplete-record-selectors++  if impl(ghc >= 9.12)+    ghc-options:+      -Werror=view-pattern-signatures++library+  import: shared+  hs-source-dirs: src+  -- We do not provide bounds on "boot libraries", as they are bundled with GHC,+  -- and hence their version is implied by the version of `base`.+  build-depends:+    bytestring,+    containers,+    exceptions >= 0.10 && < 0.11,+    file-embed >= 0.0.16 && < 0.1,+    hslua >= 2.3 && < 2.4,+    text,++  exposed-modules:+    Oughta+  other-modules:+    Oughta.Exception+    Oughta.Extract+    Oughta.Lua+    Oughta.LuaApi+    Oughta.Pos+    Oughta.Result+    Oughta.Traceback++test-suite oughta-tests+  import: shared+  type: exitcode-stdio-1.0+  hs-source-dirs: test+  main-is: Test.hs+  build-depends:+    oughta+  build-depends:+    bytestring,+    directory,+    file-embed,+    filepath,+    tasty,+    tasty-hunit,+    text,

@@ -0,0 +1,57 @@+-- | See the package [README](https://github.com/GaloisInc/oughta/blob/main/README.md) for a high-level description.+module Oughta+  ( -- * Running checks+    Output(..)+  , check+  , check'+    -- * Loading Lua programs+  , OE.LuaProgram+  , OE.addPrefix+  , OE.plainLuaProgram+  , OE.fromLines+  , OE.fromLineComments+    -- * Interpreting results+  , OR.Failure(..)+  , OR.Progress(..)+  , OR.Success(..)+  , OR.Result(..)+  , OR.resultNull+  , OR.printResult+    -- ** Source locations+  , Loc(..)+  , Pos(..)+  , OP.Span(..)+  ) where++import Control.Exception qualified as X+import Data.ByteString (ByteString)+import Oughta.Extract (LuaProgram)+import Oughta.Extract qualified as OE+import Oughta.LuaApi qualified as FCLA+import Oughta.Pos (Loc(..), Pos(..))+import Oughta.Pos qualified as OP+import Oughta.Result qualified as OR+import GHC.Stack (HasCallStack)+import Prelude hiding (lines, span)++-- | Output of the program under test+newtype Output = Output ByteString++-- | Check some program output against a Oughta Lua program.+check ::+  LuaProgram ->+  Output ->+  IO OR.Result+check prog (Output out) = FCLA.check prog out++-- | Like 'check', but throws an exception on failure.+check' ::+  HasCallStack =>+  LuaProgram ->+  Output ->+  IO ()+check' prog out = do+  OR.Result r <- check prog out+  case r of+    Left f -> X.throwIO f+    Right {} -> pure ()

@@ -0,0 +1,73 @@+{-# LANGUAGE LambdaCase #-}++module Oughta.Exception+  ( Exception(..)+  , NoMatch+  , noMatch+  , throwNoMatch+  ) where++import Control.Exception qualified as X+import Control.Monad.Catch qualified as Catch+import Control.Monad.IO.Class (liftIO)+import Data.Text qualified as Text+import Data.Text.Encoding qualified as Text+import Oughta.Result qualified as OR+import Foreign.StablePtr (StablePtr)+import Foreign.StablePtr qualified as Foreign+import HsLua qualified as Lua+import HsLua.Core.Utf8 qualified as Lua.Utf8++-- | Exceptions that may be thrown from Lua code.+--+-- Must be storable on the Lua stack. Uses opaque 'Ptr's for data that cannot be+-- inspected by Lua.+data Exception+  = LuaException Lua.Exception+    -- | @fail@ was called.+  | Failure NoMatch++-- | Wrapper for 'OR.Failure'+newtype NoMatch = NoMatch (StablePtr OR.Failure)++instance Show NoMatch where+  -- can't do IO here, but this Show instance won't be used anyway+  show (NoMatch {}) = "oughta: no match"++instance Show Exception where+  show =+    \case+      LuaException e -> show e+      Failure f -> show f++instance X.Exception Exception++noMatch :: NoMatch -> IO OR.Failure+noMatch (NoMatch sp) = Foreign.deRefStablePtr sp++throwNoMatch :: OR.Failure -> Lua.LuaE Exception a+throwNoMatch failure = do+  sp <- liftIO (Foreign.newStablePtr failure)+  Catch.throwM (Failure (NoMatch sp))++instance Lua.LuaError Exception where+  popException = do+    top <- Lua.tostring Lua.top+    case top of+      Just str -> do+        Lua.pop 1+        pure (LuaException (Lua.Exception (Text.unpack (Text.decodeUtf8Lenient str))))+      Nothing -> do+        top' <- Lua.touserdata Lua.top+        case top' of+          Just ptr -> do+            Lua.pop 1+            pure (Failure (NoMatch (Foreign.castPtrToStablePtr ptr)))+          Nothing -> Lua.failLua "Bad exception!"++  pushException =+    \case+      LuaException (Lua.Exception msg) -> Lua.pushstring (Lua.Utf8.fromString msg)+      Failure (NoMatch sp) -> Lua.pushlightuserdata (Foreign.castStablePtrToPtr sp)++  luaException s = LuaException (Lua.luaException s)

@@ -0,0 +1,99 @@+{-# LANGUAGE OverloadedStrings #-}++-- | Extract Lua programs embedded in other files+module Oughta.Extract+  ( SourceMap+  , sourceMapFile+  , lookupSourceMap+  , LuaProgram+  , programText+  , sourceMap+  , addPrefix+  , plainLuaProgram+  , fromLines+  , fromLineComments+  ) where++import Data.Foldable qualified as Foldable+import Data.IntMap.Strict (IntMap)+import Data.IntMap.Strict qualified as IntMap+import Data.Maybe qualified as Maybe+import Data.Text (Text)+import Data.Text qualified as Text++-- | Map from Lua line numbers to source line numbers+data SourceMap+  = SourceMap+    { sourceMapFile :: !Text+    , sourceMapLines :: !(IntMap Int)+    }++empty :: FilePath -> SourceMap+empty path = SourceMap (Text.pack path) IntMap.empty++lookupSourceMap ::+  -- | File path+  Text ->+  -- | Lua line number+  Int ->+  SourceMap ->+  Int+lookupSourceMap path luaLine (SourceMap f m) =+  if path == f+  then Maybe.fromMaybe luaLine (IntMap.lookup luaLine m)+  else luaLine++-- | Lua program paired with a 'SourceMap'+data LuaProgram+  = LuaProgram+    { programText :: !Text+    , sourceMap :: !SourceMap+    }++-- | Add a prefix (i.e., prelude).+--+-- Bumps all subsequent line numbers+addPrefix :: Text -> LuaProgram -> LuaProgram+addPrefix pfx prog =+  let pfx' = pfx <> "\n" in+  prog+  { programText = pfx' <> programText prog+  , sourceMap =+      let sm = sourceMap prog in+      sm { sourceMapLines = IntMap.mapKeys (+ Text.count "\n" pfx') (sourceMapLines sm) }+  }++-- | A standalone Lua program+plainLuaProgram :: FilePath -> Text -> LuaProgram+plainLuaProgram path txt = LuaProgram txt (empty path)++-- | Extract a Lua program embedded in certain lines of another file+fromLines :: FilePath -> (Text -> Maybe Text) -> Text -> LuaProgram+fromLines path filt txt =+  -- luaLineNo starts at 2 becaus we add a newline before each line+  let (_, t, m) = Foldable.foldl' go (2, "", empty path) (zip [1..] (Text.lines txt)) in+  LuaProgram t m+  where+    go (luaLineNo, t, sm) (sourceLineNo, line) =+      case filt line of+        Just line' ->+          -- trace ("LINE '" ++ Text.unpack line' ++ " at " ++ show luaLineNo ++ " is " ++ show sourceLineNo) $+          ( luaLineNo + 1+          , t <> "\n" <> line'+          , sm { sourceMapLines = IntMap.insert luaLineNo sourceLineNo (sourceMapLines sm) }+          )+        Nothing ->+          ( luaLineNo+          , t+          , sm+          )++-- | Extract a Lua program embedded in the line comments of another file+fromLineComments ::+  FilePath ->+  -- | Start of comment marker, e.g., @"# "@+  Text ->+  -- | Whole file+  Text ->+  LuaProgram+fromLineComments path c = fromLines path (Text.stripPrefix c)

@@ -0,0 +1,11 @@+{-# LANGUAGE TemplateHaskell #-}++module Oughta.Lua+  ( luaCode+  ) where++import Data.ByteString (ByteString)+import Data.FileEmbed (embedFile)++luaCode :: ByteString+luaCode = $(embedFile "src/Oughta/oughta.lua")

@@ -0,0 +1,182 @@+{-# LANGUAGE OverloadedStrings #-}++-- | The Oughta Lua API+module Oughta.LuaApi+  ( check+  ) where++import Control.Exception qualified as X+import Control.Monad.IO.Class (liftIO)+import Data.ByteString (ByteString)+import Data.ByteString qualified as BS+import Data.IORef (IORef)+import Data.IORef qualified as IORef+import Data.Text (Text)+import Data.Text qualified as Text+import Data.Text.Encoding qualified as Text+import Oughta.Exception (Exception)+import Oughta.Exception qualified as OE+import Oughta.Extract (LuaProgram, SourceMap, lookupSourceMap, programText, sourceMap, sourceMapFile)+import Oughta.Lua qualified as OL+import Oughta.Pos qualified as OP+import Oughta.Result (Progress, Result)+import Oughta.Result qualified as OR+import Oughta.Traceback qualified as OT+import HsLua qualified as Lua++-- | Name of the @text@ global variable. Not exported.+text :: Lua.Name+text = Lua.Name "text"++-- | Set the @text@ global. Not exported.+setText :: ByteString -> Lua.LuaE Exception ()+setText txt = do+  Lua.pushstring txt+  Lua.setglobal text++-- | Helper, not exported.+withProgress :: IORef Progress -> (Progress -> Lua.LuaE Exception Progress) -> Lua.LuaE Exception ()+withProgress stateRef f = do+  p <- liftIO (IORef.readIORef stateRef)+  p' <- f p+  setText (OR.progressRemainder p')+  liftIO (IORef.writeIORef stateRef p')+  pure ()++-- | Implementation of @col@. Not exported.+col :: IORef Progress -> Lua.LuaE Exception Int+col stateRef = do+  p <- liftIO (IORef.readIORef stateRef)+  pure (OP.col (OP.pos (OR.progressLoc p)))++-- | Implementation of @fail@. Not exported.+fail_ :: SourceMap -> IORef Progress -> Lua.LuaE Exception ()+fail_ sm stateRef =+  withProgress stateRef $ \p -> do+    tb <- OT.getTraceback sm+    OE.throwNoMatch (OR.Failure p tb)++-- | Implementation of @file@. Not exported.+file :: SourceMap -> Lua.LuaE Exception Text+file sm = pure (sourceMapFile sm)++-- | Implementation of @line@. Not exported.+line :: IORef Progress -> Lua.LuaE Exception Int+line stateRef = do+  p <- liftIO (IORef.readIORef stateRef)+  pure (OP.line (OP.pos (OR.progressLoc p)))++-- | Implementation of @match@. Not exported.+match :: SourceMap -> IORef Progress -> Int -> Lua.LuaE Exception ()+match sm stateRef n =+  withProgress stateRef $ \p -> do+    tb <- OT.getTraceback sm+    let txt = OR.progressRemainder p+    let (matched, remainder) = BS.splitAt n txt+    let loc = OR.progressLoc p+    let start = OP.pos loc+    let end = OP.incPos (OP.pos loc) (Text.decodeUtf8Lenient matched)+    let m =+          OR.Match+          { OR.matchRemainder = remainder+          , OR.matchSpan = OP.Span (OP.path loc) start end+          , OR.matchText = matched+          , OR.matchTraceback = tb+          }+    pure (OR.updateProgress m p)++-- | Implementation of @seek@. Not exported.+seek :: IORef Progress -> Int -> Lua.LuaE Exception ()+seek stateRef chars =+  withProgress stateRef $ \p -> do+    let loc = OR.progressLoc p+    let txt = OR.progressRemainder p+    let (before, after) = BS.splitAt chars txt+    let pos' = OP.incPos (OP.pos loc) (Text.decodeUtf8Lenient before)+    let p' =+          p+          { OR.progressLoc = loc { OP.pos = pos' }+          , OR.progressRemainder = after+          }+    pure p'++-- | Implementation of @src_line@. Not exported.+srcLine :: SourceMap -> Int -> Lua.LuaE Exception Int+srcLine sm level = do+  Lua.getglobal' "debug.getinfo"+  -- Empirically, there are 3 levels of functions on the Lua stack between this+  -- function and user Lua code.+  Lua.pushinteger (Lua.Integer (fromIntegral level + 3))+  Lua.pushstring "lnS"+  Lua.call 2 1++  _ty <- Lua.getfield Lua.top "currentline"+  l0 <- Lua.peek @Int Lua.top+  Lua.pop 1++  _ty <- Lua.getfield Lua.top "short_src"+  src0 <- Lua.peek @Text Lua.top+  Lua.pop 1+  let src = Text.drop (Text.length "[string \"") (Text.dropEnd (Text.length "\"]") src0)++  pure (lookupSourceMap src l0 sm)++-- | Load user and Oughta Lua code. Helper, not exported.+luaSetup ::+  IORef Progress ->+  -- | User code+  LuaProgram ->+  -- | Initial content of @text@ global+  ByteString ->+  Lua.LuaE Exception ()+luaSetup stateRef prog txt = do+  Lua.openlibs+  setText txt++  let sm = sourceMap prog++  Lua.pushHaskellFunction (Lua.toHaskellFunction (col stateRef))+  Lua.setglobal (Lua.Name "col_no")++  Lua.pushHaskellFunction (Lua.toHaskellFunction (fail_ sm stateRef))+  Lua.setglobal (Lua.Name "fail")++  Lua.pushHaskellFunction (Lua.toHaskellFunction (file sm))+  Lua.setglobal (Lua.Name "file")++  Lua.pushHaskellFunction (Lua.toHaskellFunction (line stateRef))+  Lua.setglobal (Lua.Name "line")++  Lua.pushHaskellFunction (Lua.toHaskellFunction (match sm stateRef))+  Lua.setglobal (Lua.Name "match")++  Lua.pushHaskellFunction (Lua.toHaskellFunction (seek stateRef))+  Lua.setglobal (Lua.Name "seek")++  Lua.pushHaskellFunction (Lua.toHaskellFunction (srcLine sm))+  Lua.setglobal (Lua.Name "src_line")++  _ <- Lua.loadbuffer OL.luaCode (Lua.Name "oughta.lua")+  Lua.call 0 0++  let nm = Lua.Name (Text.encodeUtf8 (sourceMapFile sm))+  _ <- Lua.loadbuffer (Text.encodeUtf8 (programText prog)) nm+  Lua.call 0 0++-- | Check some text against a Lua program using the API.+check ::+  LuaProgram ->+  -- | Text to check+  ByteString ->+  IO Result+check prog txt = do+  let p0 = OR.newProgress "<out>" txt+  stateRef <- IORef.newIORef p0+  result <- Lua.run (Lua.try (luaSetup stateRef prog txt))+  case result of+    Left (OE.LuaException e) -> X.throwIO e+    Left (OE.Failure noMatch) ->+      OR.Result . Left <$> OE.noMatch noMatch+    Right () -> do+      state <- IORef.readIORef stateRef+      pure (OR.Result (Right (OR.progressToSuccess state)))

@@ -0,0 +1,76 @@+{-# LANGUAGE OverloadedStrings #-}++module Oughta.Pos+  ( Pos(..)+  , incPos+  , Loc(..)+  , printLoc+  , Span(..)+  , startLoc+  , endLoc+  , printSpan+  ) where++import Data.List qualified as List+import Data.Maybe qualified as Maybe+import Data.Text qualified as Text+import Data.Text (Text)+import Prelude hiding (last, lines, span)++-- | Helper, not exported+tshow :: Show a => a -> Text+tshow = Text.pack . show++-- | A source position+data Pos+  = Pos+    { line :: {-# UNPACK #-} !Int+    , col :: {-# UNPACK #-} !Int+    }++-- | Move a position forward past a chunk of text.+incPos :: Pos -> Text -> Pos+incPos (Pos l c) t =+  let newlines = Text.count "\n" t in+  Pos (l + newlines) $+    if "\n" `Text.isSuffixOf` t+    then 1+    else+      case List.reverse (Text.lines t) of+        [] -> c+        (only : []) -> c + Text.length only+        (last : _) -> Text.length last++printPos :: Pos -> Text+printPos p = tshow (line p) <> ":" <> tshow (col p)++-- | A source location+data Loc+  = Loc+    { path :: !(Maybe FilePath)+    , pos :: {-# UNPACK #-} !Pos+    }++printLoc :: Loc -> Text+printLoc l =+  let p = Maybe.fromMaybe "<unknown file>" (path l) in+  Text.pack p <> ":" <> printPos (pos l)++-- | A source span+data Span+  = Span+  { spanPath :: !(Maybe FilePath)+  , spanStart :: {-# UNPACK #-} !Pos+  , spanEnd :: {-# UNPACK #-} !Pos+  }++startLoc :: Span -> Loc+startLoc s = Loc (spanPath s) (spanStart s)++endLoc :: Span -> Loc+endLoc s = Loc (spanPath s) (spanEnd s)++printSpan :: Span -> Text+printSpan s =+  let p = Maybe.fromMaybe "<unknown file>" (spanPath s) in+  Text.pack p <> ":" <> printPos (spanStart s) <> "-" <> printPos (spanEnd s)

@@ -0,0 +1,154 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}++-- | The result of running a Oughta Lua program+module Oughta.Result+  ( Match(..)+  , Progress(..)+  , newProgress+  , updateProgress+  , progressToSuccess+  , Failure(..)+  , Success(..)+  , Result(..)+  , resultNull+  , printResult+  ) where++import Control.Exception qualified as X+import Data.ByteString (ByteString)+import Data.Foldable (toList)+import Data.Sequence (Seq)+import Data.Sequence qualified as Seq+import Data.Text (Text)+import Data.Text qualified as Text+import Data.Text.Encoding qualified as Text+import Oughta.Pos (Loc, Span)+import Oughta.Pos qualified as OP+import Oughta.Traceback (Traceback)+import Oughta.Traceback qualified as OT++-- | A successful match of an API call against some text+data Match+  = Match+    { -- | The 'Span' of the match+      matchSpan :: {-# UNPACK #-} !Span+      -- | The 'Text' that was matched+    , matchText :: !ByteString+      -- | 'Traceback' at the time of the match+    , matchTraceback :: !Traceback+      -- | The rest of the 'Text' after the match+    , matchRemainder :: !ByteString+    }++indent :: Text+indent = "  "++indentLines :: Text -> Text+indentLines = Text.unlines . map (indent <>) . Text.lines++printMatch :: Match -> Text+printMatch m =+  Text.unlines+  [ Text.unwords+    [ "✔️ match at"+    , OP.printSpan (matchSpan m) <> ":"+    ]+  , indentLines (Text.decodeUtf8Lenient (matchText m))+  , OT.printTraceback (matchTraceback m)+  ]++-- | A sequence of successful matches of API calls against some text+data Progress+ = Progress+   { -- | t'Loc' after the last match+     progressLoc :: {-# UNPACK #-} !Loc+     -- | Successful 'Match'es+   , progressMatches :: Seq Match+     -- | Remaining text after the last match+   , progressRemainder :: !ByteString+   }++printProgress :: Progress -> Text+printProgress p = Text.unlines (map printMatch (toList (progressMatches p)))++-- | Create a new 'Progress' starting at position @'OP.Pos' 1 1@.+newProgress :: FilePath -> ByteString -> Progress+newProgress path txt =+  let loc0 = OP.Loc (Just path) (OP.Pos 1 1) in+  Progress loc0 Seq.empty txt++-- | Update 'Progress' with a new 'Match'+updateProgress :: Match -> Progress -> Progress+updateProgress m p =+  Progress+  { progressLoc = (progressLoc p) { OP.pos = OP.spanEnd (matchSpan m) }+  , progressMatches = progressMatches p Seq.:|> m+  , progressRemainder = matchRemainder m+  }++-- | Helper, not exported+progressToSuccess :: Progress -> Success+progressToSuccess (Progress loc matches remainder) =+  Success loc matches remainder++-- | Failure to match a program against some text.+data Failure+ = Failure+   { failureProgress :: Progress+   , failureTraceback :: !Traceback+   }++trunc :: Text -> Text+trunc txt =+  let ls = Text.lines txt in+  if length ls > 3+  then Text.unlines (take 3 ls) <> "\n..."+  else txt++instance Show Failure where+  show f =+    Text.unpack $+      Text.unlines+      [ ""  -- a leading newline makes the output of Tasty more readable+      , "Check failed! Passing checks:"+      , printProgress (failureProgress f)+      , "Failing check:"+      , Text.unwords+        [ "❌ no match at"+        , OP.printLoc (progressLoc (failureProgress f)) <> ":"+        ]+      , indentLines (trunc (Text.decodeUtf8Lenient (progressRemainder (failureProgress f))))+      , OT.printTraceback (failureTraceback f)+      ]++instance X.Exception Failure++-- | The result of matching a program against some text.+data Success+ = Success+   { -- | t'Loc' after the last match+     successLoc :: {-# UNPACK #-} !Loc+     -- | Successful 'Match'es+   , successMatches :: Seq Match+     -- | Remaining text after the last match+   , successRemainder :: !ByteString+   }++-- | The result of running a Oughta Lua program+newtype Result = Result (Either Failure Success)++-- | Does this 'Rusult' reflect running zero checks?+resultNull :: Result -> Bool+resultNull =+  \case+    Result (Left {}) -> False+    Result (Right s) -> null (successMatches s)++-- | Display a 'Result' in human-readable 'Text'+printResult :: Result -> Text+printResult =+  \case+    Result (Left f) -> Text.pack (show f)+    Result (Right (Success loc matches remainder)) ->+      printProgress (Progress loc matches remainder)

@@ -0,0 +1,99 @@+{-# LANGUAGE OverloadedStrings #-}++-- | Get Lua stack traces+module Oughta.Traceback+  ( Traceback+  , getTraceback+  , printTraceback+  ) where++import Data.Int (Int64)+import Data.Text (Text)+import Oughta.Extract (SourceMap)+import Oughta.Extract qualified as OE+import HsLua qualified as Lua+import qualified Data.Text as Text++-- | Data about a single stack frame+data Frame+  = Frame+    { -- | Source line number (NOT Lua line number)+      _frameLine :: {-# UNPACK #-} !Int+    , _frameName :: !Text+    , frameSource :: !Text+    }++printFrame :: Frame -> Text+printFrame (Frame line name src) =+  src <> ":" <> Text.pack (show line) <> " in " <> name++-- | The stack trace from the Lua interpreter.+--+-- Excludes C internals.+newtype Traceback = Traceback { _getTraceback :: [Frame] }++getFrame ::+  Lua.LuaError e =>+  SourceMap ->+  -- | Lua stack level+  Int64 ->+  Lua.LuaE e (Maybe Frame)+getFrame sm level = do+  Lua.getglobal' "debug.getinfo"+  Lua.pushinteger (Lua.Integer level)+  Lua.pushstring "lnS"+  Lua.call 2 1++  nil <- Lua.isnil Lua.top+  if nil+  then do+    Lua.pop 1+    pure Nothing+  else do+    _ty <- Lua.getfield Lua.top "what"+    what <- Lua.peek @Text Lua.top+    Lua.pop 1++    ty <- Lua.getfield Lua.top "name"+    name <-+      case ty of+        Lua.TypeString -> do+          name <- Lua.peek @Text Lua.top+          pure name+        _ -> pure "<main>"+    Lua.pop 1++    _ty <- Lua.getfield Lua.top "short_src"+    src0 <- Lua.peek @Text Lua.top+    Lua.pop 1++    let src = Text.drop (Text.length "[string \"") (Text.dropEnd (Text.length "\"]") src0)+    let src' =+          if what == "C"+          then "C"+          else src++    _ty <- Lua.getfield Lua.top "currentline"+    l0 <- Lua.peek @Int Lua.top+    Lua.pop 1+    let l = OE.lookupSourceMap src' l0 sm++    pure (Just (Frame l name src'))++-- | Get a Lua stack trace.+getTraceback ::+  Lua.LuaError e =>+  SourceMap ->+  Lua.LuaE e Traceback+getTraceback sm =+  Traceback . filter ((== OE.sourceMapFile sm) . frameSource) . reverse <$> go 3 []+  where+    go level frames = do+      mf <- getFrame sm level+      case mf of+        Nothing -> pure frames+        Just f -> go (level + 1) (f : frames)++printTraceback :: Traceback -> Text+printTraceback (Traceback tb) =+  Text.unlines ("stack trace:" : map (("  " <>) . printFrame) tb)

@@ -0,0 +1,31 @@+function check(needle)+  if needle == "" then+    match(0)+    return+  end+  local start, _ = string.find(text, needle, 1, true)+  if start == nil then+    fail()+  else+    seek(start - 1)+    here(needle)+  end+end++function checkln(needle)+  check(needle .. "\n")+end++function here(needle)+  local l = needle:len()+  if string.sub(text, 1, l) == needle then+    match(l)+  else+    fail()+  end+end++function hereln(needle)+  here(needle .. "\n")+end+

@@ -0,0 +1,26 @@+# check "first"+# check "fourth"+first+second+third+; check [[+; Check failed! Passing checks:+; ✔️ match at <out>:3:1-3:6:+;   first+; +; stack trace:+;   test-data/fail/check.txt:1 in <main>+; ]]+; +; check [[+; Failing check:+; ❌ no match at <out>:3:6:+;   +;   second+;   third+;   +;   ...+; +; stack trace:+;   test-data/fail/check.txt:2 in <main>+; ]]

@@ -0,0 +1,5 @@+# here "first"+first+second+third+; check "❌ no match"; check "here"

@@ -0,0 +1,2 @@+# check ""; check ""; check ""+; match_prev(); match_prev(); match_prev()

@@ -0,0 +1,4 @@+# check "fir"+# check "st"+first+; match_prev(); match_prev()

@@ -0,0 +1,19 @@+# check "first"+# check "third"+first+second+third+; check [[+; ✔️ match at <out>:3:1-3:6:+;   first+; +; stack trace:+;   test-data/pass/check.txt:1 in <main>+; ]]+; check [[+; ✔️ match at <out>:5:1-5:6:+;   third+; +; stack trace:+;   test-data/pass/check.txt:2 in <main>+; ]]

@@ -0,0 +1,3 @@+# check(file())+test-data/pass/file.txt+; match_prev()

@@ -0,0 +1,7 @@+# for i=1,3 do+#   check(string.format("Step %d", i))+# end+Step 1: Learn about Oughta+Step 2: Use it to test your project+Step 3: Enjoy!+; for i=1,3 do check "✔️" end

@@ -0,0 +1,11 @@+# function emph(s) check(s .. "!") end+# emph("Always be closing")+Always be closing!+; check [[+; ✔️ match at <out>:3:1-3:19:+;   Always be closing!+; +; stack trace:+;   test-data/pass/function.txt:1 in emph+;   test-data/pass/function.txt:2 in <main>+; ]]

@@ -0,0 +1,9 @@+# checkln "first"+# here "second\n"+# here "third"+first+second+third+; match_on_line(4); match_from_line(1)+; match_on_line(5); match_from_line(2)+; match_on_line(6); match_from_line(3)

@@ -0,0 +1,9 @@+# checkln "first"+# hereln "second"+# hereln "third"+first+second+third+; match_on_line(4); match_from_line(1)+; match_on_line(5); match_from_line(2)+; match_on_line(6); match_from_line(3)

@@ -0,0 +1,4 @@+# check("On line")+# check(string.format("%d", line()))+On line 3+; match_prev(); match_prev()

@@ -0,0 +1,3 @@+# check(name)+Oughta+; match_prev()

@@ -0,0 +1,10 @@+# check "first"++# check "third"+first+; match_prev()+; match_from_line(1)+second+third+; match_prev()+; match_from_line(3)

@@ -0,0 +1,7 @@+# checkln(string.format("%d", src_line(0)))+1+# function f() return src_line(1) end+# checkln(string.format("%d", f()))+4+; check "✔️"+; check "✔️"

@@ -0,0 +1,3 @@+# here(text)+some text+; check "✔️"

@@ -0,0 +1,4 @@+# check "🙂"+# check "🙃"+🙂🙃+; match_prev(); match_prev()

@@ -0,0 +1,8 @@+# name="Dave"+# check("Affirmative, " .. name)+# check("I'm sorry, " .. name)+HAL: Affirmative, Dave. I read you.+; match_prev()+Dave: Open the pod bay doors, HAL.+HAL: I'm sorry, Dave. I'm afraid I can't do that.+; match_prev()

@@ -0,0 +1,74 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}++{-+Test Oughta, using Oughta.++The test suite reads text files from @test-data/{fail,pass}/@ and runs Oughta+on them /twice/. All of the Lua code is embedded in the text files, on lines+that start with @#@. It first runs against the entire text file (specifically,+the non-@#@ lines). It then serializes the t'Ota.Result' and matches /that/+against the commands that start with @;@. This double-checking ensures that+directives match (and don't match) where expected, and that Oughta's output+is readable and correct (which is non-trivial, especially source span tracking).+-}+module Main (main) where++import Control.Monad qualified as Monad+import Data.ByteString (ByteString)+import Data.ByteString qualified as BS+import Data.FileEmbed (embedFile)+import Data.Function ((&))+import Data.Text qualified as Text+import Data.Text.Encoding qualified as Text+import Data.Text.IO qualified as Text.IO+import Oughta qualified as Ota+import Prelude hiding (lines)+import System.Directory qualified as Dir+import System.FilePath ((</>))+import System.FilePath qualified as FilePath+import Test.Tasty.HUnit qualified as TTH+import Test.Tasty qualified as TT++prelude :: ByteString+prelude = $(embedFile "test/test.lua")++test :: FilePath -> IO ()+test file = do+  content <- Text.IO.readFile file+  let comment = "# "+  let comment' = "; "++  -- White-out comments so that checks don't match themselves+  let isComment t = comment `Text.isPrefixOf` t ||  comment' `Text.isPrefixOf` t+  let rmComment l = if isComment l then Text.replicate (Text.length l) " " else l+  let clearComments out =+        Text.lines out &+        map rmComment &+        Text.unlines &+        Text.encodeUtf8 &+        Ota.Output++  let prog0 = Ota.fromLineComments file comment content+  let prog = Ota.addPrefix (Text.decodeUtf8Lenient prelude) prog0+  result <- Ota.check prog (clearComments content)+  TTH.assertBool file (not (Ota.resultNull result))++  let prog0' = Ota.fromLineComments file comment' content+  let prog' = Ota.addPrefix (Text.decodeUtf8Lenient prelude) prog0'+  let output'@(Ota.Output out) = clearComments (Ota.printResult result)+  BS.writeFile (FilePath.replaceExtension file "out") out+  Ota.check' prog' output'++discover :: FilePath -> IO [TT.TestTree]+discover dir = do+  entries <- map (dir </>) <$> Dir.listDirectory dir+  files <- Monad.filterM Dir.doesFileExist entries+  let txts = filter ((== ".txt") . FilePath.takeExtension) files+  pure (map (\file -> TTH.testCase file (test file)) txts)++main :: IO ()+main = do+  f <- discover "test-data/fail"+  p <- discover "test-data/pass"+  TT.defaultMain (TT.testGroup "Oughta tests" (f ++ p))

@@ -0,0 +1,18 @@+name = 'Oughta'++-- Assert that there was a match on line `i`.+function match_on_line(i)+  check(string.format('✔️ match at <out>:%d', i))+end++-- Assert that there was a match on the line just before the line of code that+-- calls this function.+function match_prev()+  match_on_line(src_line(1) - 1)+end++-- Assert that there was a match from a function call on line `i`.+function match_from_line(i)+  checkln 'stack trace:'+  here(string.format('  %s:%d', file(), i))+end