Add new module

Author: schoettl

src/Print.hs

@@ -0,0 +1,91 @@
+module Print
+where
+
+import Import
+import Types
+
+-- TODO Print output depending on --print=FORMAT (currently only v3)
+-- | Print a shell test considering the @--actual=mode@ option. See CLI
+-- documentation for details on.
+printShellTest
+  :: String               -- ^ Shelltest format. Value of option @--print[=FORMAT]@.
+  -> Maybe String         -- ^ Value of option @--actual[=MODE]@. @Nothing@ if option is not given.
+  -> ShellTest            -- ^ Test to print
+  -> Either String String -- ^ Non-matching or matching exit status
+  -> Either String String -- ^ Non-matching or matching exit status
+  -> Either Int Int       -- ^ Non-matching or matching exit status
+  -> IO ()
+printShellTest format actualMode ShellTest{command=c,stdin=i,comments=comments,
+               stdoutExpected=o_expected,stderrExpected=e_expected,exitCodeExpected=x_expected}
+               o_actual e_actual x_actual = do
+          (o,e,x) <- computeResults actualMode
+          case format of
+            "v1" -> do
+              printComments comments
+              printCommand "" c
+              printStdin "<<<" i
+              printStdouterr ">>>" o
+              printStdouterr ">>>2" e
+              printExitStatus ">>>=" x
+            "v2" -> do
+              printComments comments
+              printCommand "$ " c
+              printStdin "<<<" i
+              printStdouterr ">>>" o
+              printStdouterr ">>>2" e
+              printExitStatus ">>>=" x
+            "v3" -> do
+              printComments comments
+              printCommand "$ "  c
+              printStdin "<" i
+              printStdouterr ">" o
+              printStdouterr ">2" e
+              printExitStatus ">=" x
+            _ -> fail $ "Unsupported --print format: " ++ format
+  where
+    computeResults :: Maybe String -> IO (Maybe Matcher, Maybe Matcher, Matcher)
+    computeResults Nothing = do
+          return (o_expected, e_expected, x_expected)
+    computeResults (Just mode)
+     | mode `isPrefixOf` "all" = return
+         (Just $ Lines 0 $ fromEither o_actual -- TODO what about 0? how is it in parser?
+         ,Just $ Lines 0 $ fromEither e_actual
+         ,Numeric $ show $ fromEither x_actual)
+     | mode `isPrefixOf` "update" = return
+         (either (Just . Lines 0) (const o_expected) o_actual
+         ,either (Just . Lines 0) (const e_expected) e_actual
+         ,either (Numeric . show) (const x_expected) x_actual)
+     | otherwise = fail "Unsupported argument for --actual option. Allowed: all, update, or a prefix thereof."
+
+printComments :: [String] -> IO ()
+printComments = mapM_ (putStrLn . ("#"++)) -- TODO commentline discards leading space and comment character :(
+
+printStdin :: String -> Maybe String -> IO ()
+printStdin _ (Just "") = return ()
+printStdin _ Nothing = return ()
+printStdin prefix (Just s) = printf "%s\n%s" prefix s
+
+printCommand :: String -> TestCommand -> IO ()
+printCommand prefix (ReplaceableCommand s) = printf "%s%s\n" prefix s
+printCommand prefix (FixedCommand s)       = printf "%s %s\n" prefix s
+
+printStdouterr :: String -> Maybe Matcher -> IO ()
+printStdouterr _ Nothing                    = return ()
+printStdouterr _ (Just (Lines _ ""))        = return ()
+printStdouterr _ (Just (Numeric _))         = fail "FATAL: Cannot handle Matcher (Numeric) for stdout/stderr."
+printStdouterr _ (Just (NegativeNumeric _)) = fail "FATAL: Cannot handle Matcher (NegativeNumeric) for stdout/stderr."
+printStdouterr prefix (Just (Lines _ s))    = printf "%s\n%s\n" prefix s -- TODO trailing \n ?
+printStdouterr prefix (Just regex)          = printf "%s %s\n" prefix (show regex)
+
+printExitStatus :: String -> Matcher -> IO ()
+printExitStatus _ (Numeric "0") = return ()
+printExitStatus _ (Lines _ _) = fail "FATAL: Cannot handle Matcher (Lines) for exit status."
+printExitStatus prefix s = printf "%s %s\n" prefix (show s)
+
+mkEither :: Bool -> a -> Either a a
+mkEither True = Right
+mkEither False = Left
+
+fromEither :: Either a a -> a
+fromEither = either id id
+