Prepare code to make testing much easier.

This is primarily done by making more things json and by instrumenting
which stage in compilation to dump and others. This means I can make
bash scripts for end to end testing.

5 files changed, 196 insertions, 79 deletions

diff --git a/src/Main.hs b/Main.hs
index 2e4ee7a..34ef997 100644
--- a/src/Main.hs
+++ b/Main.hs
@@ -1,10 +1,9 @@
 module Main where
 
-import Control.Monad (forM_)
+import Control.Monad (forM_, when)
 import Control.Monad.Identity (Identity)
 import Data.Aeson (ToJSON (..), Value (..), encode)
 import qualified Data.ByteString.Lazy.Char8 as BL
-import qualified Data.Text as Text
 import qualified Data.Text.IO as TextIO
 import Data.Typeable
 import GHC.IO.Exception (ExitCode (ExitFailure, ExitSuccess))
@@ -20,11 +19,16 @@ import Language.Fiddle.Types (Commented (unCommented), SourceSpan)
 import Options.Applicative
 import qualified System.Environment as System
 import System.Exit (exitWith)
+import System.IO (stderr, hPutStrLn)
+
+newtype IntermediateAst = IntermediateAst (GenericSyntaxTree Identity (Maybe Value))
+  deriving (Typeable)
 
 compilationPipeline ::
   ( FilePath ->
     IO
       ( [Diagnostic],
+        [Artifact],
         Maybe
           ( FiddleUnit Parsed Identity (Commented SourceSpan)
           )
@@ -33,27 +37,66 @@ compilationPipeline ::
   ( FiddleUnit Parsed Identity (Commented SourceSpan) ->
     IO
       ( [Diagnostic],
+        [Artifact],
         Maybe
           (FiddleUnit Checked Identity (Commented SourceSpan))
       )
   ) ->
   CompilationPhase Parsed Checked
 compilationPipeline parse compile =
-  importResolutionPhase parse compile
-    >>> expansionPhase
-    >>> qualificationPhase
-    >>> consistencyCheckPhase
+  (dumpPhase "parsed" >>> importResolutionPhase parse compile)
+    >>> (dumpPhase "imports-resolved" >>> expansionPhase)
+    >>> (dumpPhase "expanded" >>> qualificationPhase)
+    >>> (dumpPhase "qualified" >>> consistencyCheckPhase)
+    >>> dumpPhase "checked"
+
+dumpPhase ::
+  forall stage.
+  ( Typeable stage,
+    Typeable (StageAnnotation stage),
+    ToGenericSyntaxTree (FiddleUnit stage),
+    StageAnnotation stage ~ Commented SourceSpan
+  ) =>
+  String ->
+  CompilationPhase stage stage
+dumpPhase stageName =
+  CompilationPhase
+    ( switch
+        ( long ("dump-" ++ stageName)
+            <> help
+              ( "Dump the "
+                  ++ stageName
+                  ++ " intermediate ast as parseable JSON."
+              )
+        )
+    )
+    (\_ _ -> return ([], Just ()))
+    ( \enable () ast -> do
+        when enable $
+          emitArtifact $
+            Artifact $
+              IntermediateAst (toGenericSyntaxTree (fmap (Just . toJSON) ast))
+        return ast
+    )
 
 -- | Global flags for the compiler.
-newtype GlobalFlags = GlobalFlags
-  {flagsInputFile :: String}
+data GlobalFlags = GlobalFlags
+  { flagsInputFile :: String,
+    flagsDiagnosticFormat :: DiagnosticFormat
+  }
 
 -- | Parse global flags from command line arguments.
 parseGlobalFlags :: Parser GlobalFlags
-parseGlobalFlags = GlobalFlags <$> argument str (metavar "INPUT" <> help "Input file")
+parseGlobalFlags =
+  GlobalFlags
+    <$> argument str (metavar "INPUT" <> help "Input file")
+    <*> ((\b -> if b then jsonFormat else coloredFormat) <$> switch
+      ( long "diagnostics-as-json"
+          <> help "Dump diagnostics in JSON format."
+      ))
 
 -- | Parse the input file into the initial AST stages.
-doParse :: String -> IO ([Diagnostic], Maybe (TreeType FiddleUnit Parsed))
+doParse :: String -> IO ([Diagnostic], [Artifact], Maybe (TreeType FiddleUnit Parsed))
 doParse filePath = do
   text <- TextIO.readFile filePath
   return $ compile_ $ toStage0 filePath text >>= toStage1
@@ -62,13 +105,14 @@ doParse filePath = do
 runCompilationPipeline ::
   [String] ->
   TreeType FiddleUnit Parsed ->
-  IO ([Diagnostic], Maybe (TreeType FiddleUnit Checked))
+  IO ([Diagnostic], [Artifact], Maybe (TreeType FiddleUnit Checked))
 runCompilationPipeline argv tree =
   case fromArgs argv of
     Success (_, pipelineAction) -> pipelineAction tree
     _ ->
       return
         ( [Diagnostic Error "Internal parsing failure (this is a bug)." (unCommented $ annot tree)],
+          [],
           Nothing
         )
 
@@ -78,7 +122,7 @@ fromArgs ::
   ParserResult
     ( GlobalFlags,
       TreeType FiddleUnit Parsed ->
-      IO ([Diagnostic], Maybe (TreeType FiddleUnit Checked))
+      IO ([Diagnostic], [Artifact], Maybe (TreeType FiddleUnit Checked))
     )
 fromArgs argv =
   execParserPure
@@ -105,12 +149,13 @@ main = do
 
   maybeParsedAst <- parseInputFile filePath
   case maybeParsedAst of
-    (priorDiags, Just ast) -> do
-      ((priorDiags ++) -> diags, ma) <- compilationAction ast
-      exitCode <- processCompilationResult ma
-      forM_ diags printDiagnostic
+    (priorDiags, _, Just ast) -> do
+      ((priorDiags ++) -> diags, artifacts, ma) <- compilationAction ast
+      exitCode <- processCompilationResult artifacts ma
+      printDiagnostics (flagsDiagnosticFormat globalFlags) diags
       exitWith exitCode
-    (diags, _) -> handleParsingFailure diags
+    (diags, _, _) ->
+      handleParsingFailure (flagsDiagnosticFormat globalFlags) diags
 
 -- | Parse command-line arguments, exiting on failure.
 parseCommandLineArgs ::
@@ -118,37 +163,37 @@ parseCommandLineArgs ::
   IO
     ( GlobalFlags,
       TreeType FiddleUnit Parsed ->
-      IO ([Diagnostic], Maybe (TreeType FiddleUnit Checked))
+      IO ([Diagnostic], [Artifact], Maybe (TreeType FiddleUnit Checked))
     )
 parseCommandLineArgs argv = handleParseResult (fromArgs argv)
 
 -- | Parse the input file into the initial AST.
-parseInputFile :: String -> IO ([Diagnostic], Maybe (TreeType FiddleUnit Parsed))
+parseInputFile :: String -> IO ([Diagnostic], [Artifact], Maybe (TreeType FiddleUnit Parsed))
 parseInputFile filePath = do
   text <- TextIO.readFile filePath
   return $ compile_ $ toStage0 filePath text >>= toStage1
 
 -- | Process the compilation result, printing the output and returning the exit code.
-processCompilationResult :: Maybe (TreeType FiddleUnit Checked) -> IO ExitCode
-processCompilationResult ma =
-  case ma of
-    Just ast -> do
+processCompilationResult :: [Artifact] -> Maybe (TreeType FiddleUnit Checked) -> IO ExitCode
+processCompilationResult artifacts ma = do
+  forM_ artifacts $ \case
+    Artifact (cast -> (Just (IntermediateAst ast))) ->
       putStrLn $
         BL.unpack $
           encode $
-            alterGenericSyntaxTree cleanupIdentifiers $
-              toGenericSyntaxTree $
-                fmap (Just . toJSON) ast
+            alterGenericSyntaxTree cleanupIdentifiers ast
+    Artifact _ -> return ()
+
+  case ma of
+    Just _ -> do
       return ExitSuccess
     Nothing -> do
-      putStrLn "\x1b[1;31mCompilation Failed\x1b[0m"
       return (ExitFailure 1)
 
 -- | Handle parsing failures by printing diagnostics and exiting with an error code.
-handleParsingFailure :: [Diagnostic] -> IO ()
-handleParsingFailure diags = do
-  putStrLn "\x1b[1;31mParsing Failed\x1b[0m"
-  forM_ diags printDiagnostic
+handleParsingFailure :: DiagnosticFormat -> [Diagnostic] -> IO ()
+handleParsingFailure fmt diags = do
+  printDiagnostics fmt diags
   exitWith (ExitFailure 1)
 
 -- | Clean up identifiers in the generic syntax tree for serialization.
diff --git a/package.yaml b/package.yaml
index 8ea485f..52a04d7 100644
--- a/package.yaml
+++ b/package.yaml
@@ -4,9 +4,39 @@ version: 0.5
 executables:
   fiddlec:
     main: Main.hs
-    source-dirs: src
+    dependencies:
+      - fiddle
+
+    
+library:
+  source-dirs: src
+  exposed-modules:
+    - Language.Fiddle.Ast
+    - Language.Fiddle.Compiler
+    - Language.Fiddle.Types
+    - Language.Fiddle.Compiler.ConsistencyCheck
+    - Language.Fiddle.Compiler.Expansion
+    - Language.Fiddle.Compiler.ImportResolution
+    - Language.Fiddle.Compiler.Qualification
+    - Language.Fiddle.Compiler.Stage0
+    - Language.Fiddle.GenericTree
+
+tests:
+  fiddle-test:
+    main: Spec.hs
+    source-dirs: test
+    dependencies:
+      - fiddle
+      - hspec
+      - base >= 4.0.0
+      - text
+      - containers
 
 ghc-options:
+  - -Wall
+  - -fno-warn-orphans
+  - -fno-warn-name-shadowing
+  - -fno-warn-missing-local-signatures
   - -XBangPatterns
   - -XConstraintKinds
   - -XDataKinds
@@ -31,10 +61,6 @@ ghc-options:
   - -XTypeOperators
   - -XUndecidableInstances
   - -XViewPatterns
-  - -Wall
-  - -fno-warn-orphans
-  - -fno-warn-name-shadowing
-  - -fno-warn-missing-local-signatures
 
 dependencies:
   - base >= 4.0.0
diff --git a/src/Language/Fiddle/Compiler.hs b/src/Language/Fiddle/Compiler.hs
index 049d533..812d4f6 100644
--- a/src/Language/Fiddle/Compiler.hs
+++ b/src/Language/Fiddle/Compiler.hs
@@ -11,16 +11,25 @@ import Control.Monad.RWS
 import Control.Monad.Trans.Maybe
 import Control.Monad.Writer
 import Data.Default
+import Data.Typeable
 import Language.Fiddle.Ast
 import Language.Fiddle.Types
 import Options.Applicative
 import System.IO (hPutStrLn, stderr)
+import qualified Data.ByteString.Lazy.Char8 as BL
 import Text.Parsec (sourceColumn, sourceLine, sourceName)
+import Data.Aeson (FromJSON, ToJSON (toJSON), encode)
+import GHC.Generics (Generic)
 
 data Level = Error | Warning | Info
-  deriving (Eq, Ord, Show, Read, Enum)
+  deriving (Eq, Ord, Show, Read, Enum, ToJSON, FromJSON, Generic)
 
-data Diagnostic = Diagnostic Level String SourceSpan
+data Diagnostic = Diagnostic {
+  diagnosticLevel :: Level,
+  diagnosticMesasge :: String,
+  diagnosticLocation :: SourceSpan
+  }
+  deriving (Generic, ToJSON, FromJSON, Typeable)
 
 emitDiagnosticError :: String -> Commented SourceSpan -> Compile a ()
 emitDiagnosticError str a = tell [Diagnostic Error str (unCommented a)]
@@ -31,16 +40,21 @@ emitDiagnosticWarning str a = tell [Diagnostic Warning str (unCommented a)]
 emitDiagnosticInfo :: String -> Commented SourceSpan -> Compile a ()
 emitDiagnosticInfo str a = tell [Diagnostic Info str (unCommented a)]
 
-newtype Compile s a = Compile (MaybeT (RWS () [Diagnostic] s) a)
+data Artifact where
+  Artifact :: forall t. (Typeable t) => t -> Artifact
+
+newtype Compile s a = Compile (MaybeT (RWS () ([Diagnostic], [Artifact]) s) a)
   deriving newtype (Functor, Applicative, Monad)
 
 compilationFailure :: Compile s a
 compilationFailure = Compile $ MaybeT (return Nothing)
 
 instance MonadWriter [Diagnostic] (Compile s) where
-  tell = Compile . tell
-  listen (Compile fn) = Compile $ listen fn
-  pass (Compile fn) = Compile $ pass fn
+  tell t = Compile $ tell (t, [])
+  listen (Compile fn) = Compile $ do
+    (a, (ds, _)) <- listen fn
+    return (a, ds)
+  pass (Compile mfun) = Compile $ pass (second first <$> mfun)
 
 instance MonadState s (Compile s) where
   get = Compile get
@@ -53,28 +67,34 @@ subCompile s' (Compile mtrws) = Compile $ do
   tell w
   MaybeT $ return $ fmap (s,) a
 
+emitArtifact :: Artifact -> Compile s ()
+emitArtifact art = Compile $ tell ([], [art])
+
 pushState :: Compile s a -> Compile s a
 pushState cp = do
   s <- get
   snd <$> subCompile s cp
 
-compile :: Compile s a -> s -> ([Diagnostic], Maybe a)
+compile :: Compile s a -> s -> ([Diagnostic], [Artifact], Maybe a)
 compile (Compile fn) initState = do
-  let (a, _, w) = runRWS (runMaybeT fn) () initState
-   in if hasError w then (w, Nothing) else (w, a)
+  let (a, _, (w, as)) = runRWS (runMaybeT fn) () initState
+   in if hasError w then (w, as, Nothing) else (w, as, a)
   where
     hasError = any (\(Diagnostic e _ _) -> e == Error)
 
-compile_ :: (Default s) => Compile s a -> ([Diagnostic], Maybe a)
+compile_ :: (Default s) => Compile s a -> ([Diagnostic], [Artifact], Maybe a)
 compile_ c = compile c def
 
 hoistMaybe :: Maybe a -> Compile s a
 hoistMaybe = Compile . MaybeT . return
 
-newtype DiagnosticFormat = DiagnosticFormat (Diagnostic -> String)
+newtype DiagnosticFormat = DiagnosticFormat ([Diagnostic] -> String)
+
+jsonFormat :: DiagnosticFormat
+jsonFormat = DiagnosticFormat $ BL.unpack . encode . toJSON
 
 coloredFormat :: DiagnosticFormat
-coloredFormat = DiagnosticFormat $ \(Diagnostic level message (SourceSpan pos1 pos2)) ->
+coloredFormat = DiagnosticFormat $ \diags -> unlines $ map (\(Diagnostic level message (SourceSpan pos1 pos2)) ->
   execWriter $ do
     case level of
       Error -> tell "\x1b[01;31mError "
@@ -90,18 +110,22 @@ coloredFormat = DiagnosticFormat $ \(Diagnostic level message (SourceSpan pos1 p
       tellPos pos2
     tell "): "
     tell (unwords $ words message)
+  ) diags
   where
     tellPos pos = do
       tell (show $ sourceLine pos)
       tell ":"
       tell (show $ sourceColumn pos)
 
-diagnosticToString :: DiagnosticFormat -> Diagnostic -> String
-diagnosticToString (DiagnosticFormat f) = f
+diagnosticsToString :: DiagnosticFormat -> [Diagnostic] -> String
+diagnosticsToString (DiagnosticFormat f) = f
+
+printDiagnostics :: DiagnosticFormat -> [Diagnostic] -> IO ()
+printDiagnostics fmt d = hPutStrLn stderr (diagnosticsToString fmt d)
 
 printDiagnostic :: Diagnostic -> IO ()
 printDiagnostic d =
-  hPutStrLn stderr (diagnosticToString coloredFormat d)
+  hPutStrLn stderr (diagnosticsToString coloredFormat [d])
 
 fromMayberOrFail :: SourceSpan -> String -> Maybe a -> Compile s a
 fromMayberOrFail sourceSpan err Nothing = do
@@ -127,6 +151,9 @@ pureCompilationPhase ::
 pureCompilationPhase fn =
   CompilationPhase (pure ()) (\_ _ -> return ([], Just ())) (\_ _ -> fn)
 
+emitArtifacts :: [Artifact] -> Compile s ()
+emitArtifacts arts = Compile $ tell ([], arts)
+
 -- data IOActionExtraData = IOActionExtraData
 --   { parseFile :: FilePath -> IO (TreeType FiddleUnit Parsed),
 --     stage3Compile :: TreeType FiddleUnit Parsed ->
@@ -140,7 +167,7 @@ pureCompilationPhase fn =
 data CompilationPhase stageFrom stageTo where
   CompilationPhase ::
     forall privateFlags privateState stageFrom stageTo.
-    (CompilationStage stageFrom) =>
+    -- (CompilationStage stageFrom) =>
     { optionsParser :: Parser privateFlags,
       -- | 'ioAction' is an IO operation that runs after the ast is parsed. It
       -- takes the parsed 'FiddleUnit' and performs some side effect
@@ -211,6 +238,7 @@ execCompilationPipelineWithCmdline ::
     ( FiddleUnit Parsed Identity (StageAnnotation Parsed) ->
       IO
         ( [Diagnostic],
+          [Artifact],
           Maybe
             ( FiddleUnit s' Identity (StageAnnotation s')
             )
@@ -222,8 +250,8 @@ execCompilationPipelineWithCmdline
       ( \opts ast -> do
           (diags, ms) <- ioAct opts ast
           case ms of
-            Just s -> return $ first (diags ++) $ compile_ $ rest opts s ast
-            Nothing -> return (diags, Nothing)
+            Just s -> return $ (\(a, b, c) -> (diags ++ a, b, c)) $ compile_ $ rest opts s ast
+            Nothing -> return (diags, [], Nothing)
       )
       flagsParser
 
diff --git a/src/Language/Fiddle/Compiler/ImportResolution.hs b/src/Language/Fiddle/Compiler/ImportResolution.hs
index b475801..f3ddee0 100644
--- a/src/Language/Fiddle/Compiler/ImportResolution.hs
+++ b/src/Language/Fiddle/Compiler/ImportResolution.hs
@@ -8,16 +8,19 @@ module Language.Fiddle.Compiler.ImportResolution
   )
 where
 
+import qualified Codec.Compression.GZip as GZip
 import Control.Arrow (Arrow (second))
-import Control.Monad (filterM)
+import Control.Monad (filterM, when)
 import Control.Monad.Identity (Identity)
 import Control.Monad.Trans.Maybe (MaybeT (MaybeT, runMaybeT))
 import Control.Monad.Writer.Lazy (MonadTrans (lift), MonadWriter (tell), WriterT (..), execWriterT)
 import Data.Aeson (eitherDecode, encode)
+import qualified Data.ByteString.Lazy as BL
 import Data.Map (Map)
-import Data.Maybe (fromMaybe)
+import qualified Data.Map as Map
+import Data.Maybe (fromMaybe, isNothing)
 import Data.Text (Text)
-import Data.Tuple (swap)
+import qualified Data.Text as Text
 import Data.Typeable
 import Language.Fiddle.Ast
 import Language.Fiddle.Compiler
@@ -28,11 +31,7 @@ import Options.Applicative
 import System.Directory
 import System.FilePath
 import Text.Printf (printf)
-
-import qualified Codec.Compression.GZip as GZip
-import qualified Data.ByteString.Lazy as BL
-import qualified Data.Map as Map
-import qualified Data.Text as Text
+import Control.Monad.State (put)
 
 newtype Flags = Flags
   { importDirectories :: [FilePath]
@@ -52,16 +51,16 @@ parseFlags =
 
 importResolutionPhase ::
   ( FilePath ->
-    IO ([Diagnostic], Maybe (TreeType FiddleUnit Parsed))
+    IO ([Diagnostic], [Artifact], Maybe (TreeType FiddleUnit Parsed))
   ) ->
   ( TreeType FiddleUnit Parsed ->
-    IO ([Diagnostic], Maybe (TreeType FiddleUnit Checked))
+    IO ([Diagnostic], [Artifact], Maybe (TreeType FiddleUnit Checked))
   ) ->
   CompilationPhase CurrentStage ImportsResolved
 importResolutionPhase parseFile compileToChecked =
   CompilationPhase parseFlags (getImportResolutionState parseFile compileToChecked) resolveImports
 
-type GlobalState = ()
+type GlobalState = Bool
 
 type LocalState = ResolvedImports
 
@@ -90,7 +89,17 @@ resolveImports ::
   ResolvedImports ->
   FiddleUnit CurrentStage I Annot ->
   Compile () (FiddleUnit ImportsResolved I Annot)
-resolveImports _ = advanceStage
+resolveImports _ localState t = do
+  (b, a) <- subCompile False $ advanceStage localState t
+  if b
+    then compilationFailure
+    else return a
+
+-- | Mark the current compilation as failed, but allows the import resolution to
+-- continue in order to allow all import failures to be reported at the same
+-- time rather than as piecemeal.
+markFatal :: Compile Bool ()
+markFatal = put True
 
 deriving instance AdvanceStage CurrentStage ObjTypeBody
 
@@ -132,19 +141,21 @@ instance AdvanceStage CurrentStage ImportStatement where
     v <- case what of
       Nothing -> do
         emitDiagnosticError "Failed to lookup imports (This is a bug)" a
+        markFatal
         return empty
       Just (diags, val) -> do
         tell diags
+        when (isNothing val) markFatal
         return $ fromMaybe empty val
 
     return $ ImportStatement path list v a
 
 getImportResolutionState ::
   ( FilePath ->
-    IO ([Diagnostic], Maybe (TreeType FiddleUnit Parsed))
+    IO ([Diagnostic], [Artifact], Maybe (TreeType FiddleUnit Parsed))
   ) ->
   ( TreeType FiddleUnit Parsed ->
-    IO ([Diagnostic], Maybe (TreeType FiddleUnit Checked))
+    IO ([Diagnostic], [Artifact], Maybe (TreeType FiddleUnit Checked))
   ) ->
   Flags ->
   FiddleUnit CurrentStage Identity Annot ->
@@ -164,7 +175,7 @@ getImportResolutionState parseFile compileToChecked flags unit = do
           | Just
               (ImportStatement {importPath = path, importStatementAnnot = (unCommented -> a)}) <-
               castTS u -> do
-              (diagnostics, unitInterface) <-
+              (diagnostics, _, unitInterface) <-
                 lift $
                   ioGetImportInterface a (importDirectories flags) (Text.unpack path)
 
@@ -190,7 +201,7 @@ getImportResolutionState parseFile compileToChecked flags unit = do
         then (diags, Nothing)
         else (diags, a)
 
-    ioGetImportInterface :: SourceSpan -> [FilePath] -> FilePath -> IO ([Diagnostic], Maybe UnitInterface)
+    ioGetImportInterface :: SourceSpan -> [FilePath] -> FilePath -> IO ([Diagnostic], [Artifact], Maybe UnitInterface)
     ioGetImportInterface srcSpan imports fp = runCompl $ do
       path <- findFileInImportPath srcSpan imports fp
       let intf = interfaceFile path
@@ -212,8 +223,8 @@ getImportResolutionState parseFile compileToChecked flags unit = do
                 then doFullCompile
                 else return val
             Left err -> do
-              tell [Diagnostic Warning "Doing recompile" srcSpan]
-              tell [Diagnostic Warning err srcSpan]
+              tell ([Diagnostic Warning "Doing recompile" srcSpan], [])
+              tell ([Diagnostic Warning err srcSpan], [])
               doFullCompile
         else doFullCompile
 
@@ -254,23 +265,23 @@ getImportResolutionState parseFile compileToChecked flags unit = do
 
       case realPaths of
         [] -> do
-          lift $ tell [Diagnostic Error (printf "Cannot find %s on path" path) sourceSpan]
+          lift $ tell ([Diagnostic Error (printf "Cannot find %s on path" path) sourceSpan], [])
           MaybeT (return Nothing)
         (a : _) -> return a
 
-bump :: IO ([Diagnostic], Maybe a) -> Compl a
+bump :: IO ([Diagnostic], [Artifact], Maybe a) -> Compl a
 bump x = do
-  (diags, ma) <- lift2 x
-  lift $ tell diags
+  (diags, artifacts, ma) <- lift2 x
+  lift $ tell (diags, artifacts)
   MaybeT (return ma)
 
 lift2 :: (Monad m, MonadTrans t0, MonadTrans t1) => m a -> t0 (t1 m) a
 lift2 = lift . lift
 
-runCompl :: Compl a -> IO ([Diagnostic], Maybe a)
-runCompl c = swap <$> runWriterT (runMaybeT c)
+runCompl :: Compl a -> IO ([Diagnostic], [Artifact], Maybe a)
+runCompl c = (\(x, (y, z)) -> (y, z, x)) <$> runWriterT (runMaybeT c)
 
-type Compl a = MaybeT (WriterT [Diagnostic] IO) a
+type Compl a = MaybeT (WriterT ([Diagnostic], [Artifact]) IO) a
 
 allM :: (Monad m) => (a -> m Bool) -> [a] -> m Bool
 allM _ [] = return True
diff --git a/test/Spec.hs b/test/Spec.hs
new file mode 100644
index 0000000..834ade8
--- /dev/null
+++ b/test/Spec.hs
@@ -0,0 +1,7 @@
+import Test.Hspec
+
+main :: IO ()
+main = hspec $ do
+  describe "add" $ do
+    it "adds two positive numbers" $ do
+      2 + 3 `shouldBe` 5