ghc_tests_as_lib.md

» find ghc/testsuite/tests -type d -name "*.run_dir*" | wc -l                                                                                                                                                                                                $
7163

-- | `Nothing` if no change
type EditM = MaybeT (ReaderT DynFlags Hsc)

infixr 0 >-
-- | `Hsc` edits (return `Nothing` if not changed)
type (>-) a b = (a -> EditM a) -> b -> EditM b

newtype Edited a = Edited { runEdited :: Kleisli EditM a a }

instance Semigroup (Edited a) where
  Edited (Kleisli f) <> Edited (Kleisli g) =
    Edited . Kleisli $ \x ->
      MaybeT $ do
        y <- runMaybeT $ f x
        case y of
          Nothing -> runMaybeT $ g x
          ~(Just z) -> Just . fromMaybe z <$> runMaybeT (g x)

instance Monoid (Edited a) where
  mempty = Edited . Kleisli . const . MaybeT . return $ Nothing

editedFAlg :: Functor f => (f a -> a) -> Edited a -> Edited (f a)
editedFAlg f (Edited (Kleisli g)) = Edited . Kleisli $ \x -> MaybeT $ do
  y <- runMaybeT $ g (f x)
  return $ (<$ x) <$> y

runEdit :: a >- b -> Edited a -> Edited b
runEdit f = Edited . Kleisli . f . runKleisli . runEdited

-- | Note: this simply collects edits as single edits: it's not equivalent to editList for lists
editT :: Traversable f => a >- b -> a >- f b
editT f g xs = mapM (f g) xs

parsePragmasIntoDynFlags ::
     DynFlags -> FilePath -> String -> IO (Maybe DynFlags)
parsePragmasIntoDynFlags flags filepath str =
  catchErrors $ do
    let opts = getOptions flags (stringToStringBuffer str) filepath
    (flags, _, _) <- parseDynamicFilePragma flags opts
    return $ Just flags
  where
    catchErrors :: IO (Maybe DynFlags) -> IO (Maybe DynFlags)
    catchErrors act =
      handleGhcException reportErr (handleSourceError reportErr act)
    reportErr e = do
      putStrLn $ "error : " ++ show e
      return Nothing