{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ViewPatterns #-}

module Test.Tasty.AutoCollect.ConvertTest (
  plugin,
) where

import Control.Arrow ((&&&))
import Control.Monad (unless, zipWithM)
import Control.Monad.Trans.State.Strict (State)
import qualified Control.Monad.Trans.State.Strict as State
import Data.Foldable (toList)
import qualified Data.List.NonEmpty as NonEmpty
import Data.Maybe (isNothing)
import Data.Sequence (Seq)
import qualified Data.Sequence as Seq
import qualified Data.Text as Text

import Test.Tasty.AutoCollect.Constants
import Test.Tasty.AutoCollect.Error
import Test.Tasty.AutoCollect.ExternalNames
import Test.Tasty.AutoCollect.GHC

-- | The plugin to convert a test file. Injected by the preprocessor.
plugin :: Plugin
plugin :: Plugin
plugin =
  Plugin -> Plugin
setKeepRawTokenStream
    Plugin
defaultPlugin
      { pluginRecompile :: [CommandLineOption] -> IO PluginRecompile
pluginRecompile = [CommandLineOption] -> IO PluginRecompile
purePlugin
      , parsedResultAction :: [CommandLineOption]
-> ModSummary -> HsParsedModule -> Hsc HsParsedModule
parsedResultAction = \[CommandLineOption]
_ ModSummary
_ HsParsedModule
modl -> do
          HscEnv
env <- Hsc HscEnv
getHscEnv
          ExternalNames
names <- IO ExternalNames -> Hsc ExternalNames
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ExternalNames -> Hsc ExternalNames)
-> IO ExternalNames -> Hsc ExternalNames
forall a b. (a -> b) -> a -> b
$ HscEnv -> IO ExternalNames
loadExternalNames HscEnv
env
          HsParsedModule -> Hsc HsParsedModule
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HsParsedModule -> Hsc HsParsedModule)
-> HsParsedModule -> Hsc HsParsedModule
forall a b. (a -> b) -> a -> b
$ ExternalNames -> HsParsedModule -> HsParsedModule
transformTestModule ExternalNames
names HsParsedModule
modl
      }

{- |
Transforms a test module of the form

@
{\- AUTOCOLLECT.TEST -\}
module MyTest (
  foo,
  {\- AUTOCOLLECT.TEST.export -\}
  bar,
) where

test = ...
@

to the equivalent of

@
module MyTest (
  foo,
  tasty_tests,
  bar,
) where

tasty_tests :: [TestTree]
tasty_tests = [tasty_test_1]

tasty_test_1 :: TestTree
tasty_test_1 = ...
@
-}
transformTestModule :: ExternalNames -> HsParsedModule -> HsParsedModule
transformTestModule :: ExternalNames -> HsParsedModule -> HsParsedModule
transformTestModule ExternalNames
names HsParsedModule
parsedModl = HsParsedModule
parsedModl{hpm_module :: Located (HsModule GhcPs)
hpm_module = HsModule GhcPs -> HsModule GhcPs
updateModule (HsModule GhcPs -> HsModule GhcPs)
-> Located (HsModule GhcPs) -> Located (HsModule GhcPs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HsParsedModule -> Located (HsModule GhcPs)
hpm_module HsParsedModule
parsedModl}
  where
    updateModule :: HsModule GhcPs -> HsModule GhcPs
updateModule HsModule GhcPs
modl =
      let ([LHsDecl GhcPs]
decls, [LocatedN RdrName]
testNames) = ConvertTestM [LHsDecl GhcPs]
-> ([LHsDecl GhcPs], [LocatedN RdrName])
forall a. ConvertTestM a -> (a, [LocatedN RdrName])
runConvertTestM (ConvertTestM [LHsDecl GhcPs]
 -> ([LHsDecl GhcPs], [LocatedN RdrName]))
-> ConvertTestM [LHsDecl GhcPs]
-> ([LHsDecl GhcPs], [LocatedN RdrName])
forall a b. (a -> b) -> a -> b
$ (LHsDecl GhcPs -> ConvertTestM [LHsDecl GhcPs])
-> [LHsDecl GhcPs] -> ConvertTestM [LHsDecl GhcPs]
forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM (ExternalNames -> LHsDecl GhcPs -> ConvertTestM [LHsDecl GhcPs]
convertTest ExternalNames
names) ([LHsDecl GhcPs] -> ConvertTestM [LHsDecl GhcPs])
-> [LHsDecl GhcPs] -> ConvertTestM [LHsDecl GhcPs]
forall a b. (a -> b) -> a -> b
$ HsModule GhcPs -> [LHsDecl GhcPs]
forall pass. HsModule pass -> [LHsDecl pass]
hsmodDecls HsModule GhcPs
modl
       in HsModule GhcPs
modl
            { hsmodExports :: Maybe (Located [LIE GhcPs])
hsmodExports = Located [LIE GhcPs] -> Located [LIE GhcPs]
updateExports (Located [LIE GhcPs] -> Located [LIE GhcPs])
-> Maybe (Located [LIE GhcPs]) -> Maybe (Located [LIE GhcPs])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HsModule GhcPs -> Maybe (Located [LIE GhcPs])
forall pass. HsModule pass -> Maybe (Located [LIE pass])
hsmodExports HsModule GhcPs
modl
            , hsmodDecls :: [LHsDecl GhcPs]
hsmodDecls = [LocatedN RdrName] -> [LHsDecl GhcPs]
mkTestsList [LocatedN RdrName]
testNames [LHsDecl GhcPs] -> [LHsDecl GhcPs] -> [LHsDecl GhcPs]
forall a. [a] -> [a] -> [a]
++ [LHsDecl GhcPs]
decls
            }

    -- Replace "{- AUTOCOLLECT.TEST.export -}" with `tests` in the export list
    updateExports :: Located [LIE GhcPs] -> Located [LIE GhcPs]
updateExports Located [LIE GhcPs]
lexports
      | Just RealSrcSpan
exportSpan <- (GenLocated RealSrcSpan CommandLineOption -> Maybe RealSrcSpan)
-> [GenLocated RealSrcSpan CommandLineOption] -> Maybe RealSrcSpan
forall l e a.
Ord l =>
(GenLocated l e -> Maybe a) -> [GenLocated l e] -> Maybe a
firstLocatedWhere GenLocated RealSrcSpan CommandLineOption -> Maybe RealSrcSpan
forall a. GenLocated a CommandLineOption -> Maybe a
getTestExportAnnSrcSpan (HsParsedModule
-> Located [LIE GhcPs]
-> [GenLocated RealSrcSpan CommandLineOption]
getExportComments HsParsedModule
parsedModl Located [LIE GhcPs]
lexports) =
          (SrcSpan -> IE GhcPs -> LIE GhcPs
forall l e. l -> e -> GenLocated l e
L (RealSrcSpan -> SrcSpan
toSrcAnnA RealSrcSpan
exportSpan) IE GhcPs
exportIE LIE GhcPs -> [LIE GhcPs] -> [LIE GhcPs]
forall a. a -> [a] -> [a]
:) ([LIE GhcPs] -> [LIE GhcPs])
-> Located [LIE GhcPs] -> Located [LIE GhcPs]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Located [LIE GhcPs]
lexports
      | Bool
otherwise =
          Located [LIE GhcPs]
lexports
    getTestExportAnnSrcSpan :: GenLocated a CommandLineOption -> Maybe a
getTestExportAnnSrcSpan (L a
loc CommandLineOption
comment) =
      if CommandLineOption -> Bool
isTestExportComment CommandLineOption
comment
        then a -> Maybe a
forall a. a -> Maybe a
Just a
loc
        else Maybe a
forall a. Maybe a
Nothing
    exportIE :: IE GhcPs
exportIE = XIEVar GhcPs -> LIEWrappedName (IdP GhcPs) -> IE GhcPs
forall pass. XIEVar pass -> LIEWrappedName (IdP pass) -> IE pass
IEVar NoExtField
XIEVar GhcPs
NoExtField (LIEWrappedName (IdP GhcPs) -> IE GhcPs)
-> LIEWrappedName (IdP GhcPs) -> IE GhcPs
forall a b. (a -> b) -> a -> b
$ IEWrappedName RdrName -> GenLocated SrcSpan (IEWrappedName RdrName)
forall e ann. e -> GenLocated SrcSpan e
genLoc (IEWrappedName RdrName
 -> GenLocated SrcSpan (IEWrappedName RdrName))
-> IEWrappedName RdrName
-> GenLocated SrcSpan (IEWrappedName RdrName)
forall a b. (a -> b) -> a -> b
$ LocatedN RdrName -> IEWrappedName RdrName
forall name. Located name -> IEWrappedName name
IEName LocatedN RdrName
testListName

    -- Generate the `tests` list
    mkTestsList :: [LocatedN RdrName] -> [LHsDecl GhcPs]
    mkTestsList :: [LocatedN RdrName] -> [LHsDecl GhcPs]
mkTestsList [LocatedN RdrName]
testNames =
      let testsList :: GenLocated SrcSpan (HsExpr GhcPs)
testsList = HsExpr GhcPs -> GenLocated SrcSpan (HsExpr GhcPs)
forall e ann. e -> GenLocated SrcSpan e
genLoc (HsExpr GhcPs -> GenLocated SrcSpan (HsExpr GhcPs))
-> HsExpr GhcPs -> GenLocated SrcSpan (HsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ [GenLocated SrcSpan (HsExpr GhcPs)] -> HsExpr GhcPs
mkExplicitList ([GenLocated SrcSpan (HsExpr GhcPs)] -> HsExpr GhcPs)
-> [GenLocated SrcSpan (HsExpr GhcPs)] -> HsExpr GhcPs
forall a b. (a -> b) -> a -> b
$ (LocatedN RdrName -> GenLocated SrcSpan (HsExpr GhcPs))
-> [LocatedN RdrName] -> [GenLocated SrcSpan (HsExpr GhcPs)]
forall a b. (a -> b) -> [a] -> [b]
map LocatedN RdrName -> GenLocated SrcSpan (HsExpr GhcPs)
lhsvar [LocatedN RdrName]
testNames
       in [ HsDecl GhcPs -> LHsDecl GhcPs
forall e ann. e -> GenLocated SrcSpan e
genLoc (HsDecl GhcPs -> LHsDecl GhcPs) -> HsDecl GhcPs -> LHsDecl GhcPs
forall a b. (a -> b) -> a -> b
$ LocatedN RdrName -> LHsType GhcPs -> HsDecl GhcPs
genFuncSig LocatedN RdrName
testListName (LHsType GhcPs -> HsDecl GhcPs) -> LHsType GhcPs -> HsDecl GhcPs
forall a b. (a -> b) -> a -> b
$ ExternalNames -> LHsType GhcPs
getListOfTestTreeType ExternalNames
names
          , HsDecl GhcPs -> LHsDecl GhcPs
forall e ann. e -> GenLocated SrcSpan e
genLoc (HsDecl GhcPs -> LHsDecl GhcPs) -> HsDecl GhcPs -> LHsDecl GhcPs
forall a b. (a -> b) -> a -> b
$ LocatedN RdrName
-> [LPat GhcPs]
-> GenLocated SrcSpan (HsExpr GhcPs)
-> Maybe (HsLocalBinds GhcPs)
-> HsDecl GhcPs
genFuncDecl LocatedN RdrName
testListName [] (GenLocated SrcSpan (HsExpr GhcPs)
-> GenLocated SrcSpan (HsExpr GhcPs)
flattenTestList GenLocated SrcSpan (HsExpr GhcPs)
forall ann. GenLocated SrcSpan (HsExpr GhcPs)
testsList) Maybe (HsLocalBinds GhcPs)
forall a. Maybe a
Nothing
          ]

    flattenTestList :: GenLocated SrcSpan (HsExpr GhcPs)
-> GenLocated SrcSpan (HsExpr GhcPs)
flattenTestList GenLocated SrcSpan (HsExpr GhcPs)
testsList =
      GenLocated SrcSpan (HsExpr GhcPs)
-> GenLocated SrcSpan (HsExpr GhcPs)
-> GenLocated SrcSpan (HsExpr GhcPs)
forall (id :: Pass).
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
mkHsApp (Name -> GenLocated SrcSpan (HsExpr GhcPs)
mkHsVar (Name -> GenLocated SrcSpan (HsExpr GhcPs))
-> Name -> GenLocated SrcSpan (HsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ ExternalNames -> Name
name_concat ExternalNames
names) (GenLocated SrcSpan (HsExpr GhcPs)
 -> GenLocated SrcSpan (HsExpr GhcPs))
-> GenLocated SrcSpan (HsExpr GhcPs)
-> GenLocated SrcSpan (HsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$
        GenLocated SrcSpan (HsExpr GhcPs)
-> LHsType GhcPs -> GenLocated SrcSpan (HsExpr GhcPs)
mkExprTypeSig GenLocated SrcSpan (HsExpr GhcPs)
testsList (LHsType GhcPs -> GenLocated SrcSpan (HsExpr GhcPs))
-> (HsType GhcPs -> LHsType GhcPs)
-> HsType GhcPs
-> GenLocated SrcSpan (HsExpr GhcPs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsType GhcPs -> LHsType GhcPs
forall e ann. e -> GenLocated SrcSpan e
genLoc (HsType GhcPs -> GenLocated SrcSpan (HsExpr GhcPs))
-> HsType GhcPs -> GenLocated SrcSpan (HsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$
          XListTy GhcPs -> LHsType GhcPs -> HsType GhcPs
forall pass. XListTy pass -> LHsType pass -> HsType pass
HsListTy NoExtField
XListTy GhcPs
noAnn (ExternalNames -> LHsType GhcPs
getListOfTestTreeType ExternalNames
names)

{- |
If the given declaration is a test, return the converted test, or otherwise
return it unmodified
-}
convertTest :: ExternalNames -> LHsDecl GhcPs -> ConvertTestM [LHsDecl GhcPs]
convertTest :: ExternalNames -> LHsDecl GhcPs -> ConvertTestM [LHsDecl GhcPs]
convertTest ExternalNames
names LHsDecl GhcPs
ldecl =
  case LHsDecl GhcPs -> Maybe ParsedDecl
parseDecl LHsDecl GhcPs
ldecl of
    Just (FuncSig [LocatedN RdrName
funcName] LHsSigWcType GhcPs
ty)
      | Just TestType
testType <- CommandLineOption -> Maybe TestType
parseTestType (LocatedN RdrName -> CommandLineOption
fromRdrName LocatedN RdrName
funcName) -> do
          LocatedN RdrName
testName <- ConvertTestM (LocatedN RdrName)
getNextTestName
          SigInfo -> ConvertTestM ()
setLastSeenSig
            SigInfo :: TestType -> LocatedN RdrName -> LHsSigWcType GhcPs -> SigInfo
SigInfo
              { TestType
testType :: TestType
testType :: TestType
testType
              , LocatedN RdrName
testName :: LocatedN RdrName
testName :: LocatedN RdrName
testName
              , signatureType :: LHsSigWcType GhcPs
signatureType = LHsSigWcType GhcPs
ty
              }
          Bool -> ConvertTestM () -> ConvertTestM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ExternalNames -> TestType -> LHsSigWcType GhcPs -> Bool
isValidForTestType ExternalNames
names TestType
testType LHsSigWcType GhcPs
ty) (ConvertTestM () -> ConvertTestM ())
-> ConvertTestM () -> ConvertTestM ()
forall a b. (a -> b) -> a -> b
$
            CommandLineOption -> ConvertTestM ()
forall a. CommandLineOption -> a
autocollectError (CommandLineOption -> ConvertTestM ())
-> ([CommandLineOption] -> CommandLineOption)
-> [CommandLineOption]
-> ConvertTestM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CommandLineOption] -> CommandLineOption
unlines ([CommandLineOption] -> ConvertTestM ())
-> [CommandLineOption] -> ConvertTestM ()
forall a b. (a -> b) -> a -> b
$
              [ CommandLineOption
"Expected type: " CommandLineOption -> CommandLineOption -> CommandLineOption
forall a. [a] -> [a] -> [a]
++ TestType -> CommandLineOption
typeForTestType TestType
testType
              , CommandLineOption
"Got: " CommandLineOption -> CommandLineOption -> CommandLineOption
forall a. [a] -> [a] -> [a]
++ LHsSigWcType GhcPs -> CommandLineOption
forall a. Outputable a => a -> CommandLineOption
showPpr LHsSigWcType GhcPs
ty
              ]
          [LHsDecl GhcPs] -> ConvertTestM [LHsDecl GhcPs]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [LocatedN RdrName -> LHsType GhcPs -> HsDecl GhcPs
genFuncSig LocatedN RdrName
testName (ExternalNames -> LHsType GhcPs
getListOfTestTreeType ExternalNames
names) HsDecl GhcPs -> LHsDecl GhcPs -> LHsDecl GhcPs
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ LHsDecl GhcPs
ldecl]
    Just (FuncDef LocatedN RdrName
funcName [LocatedA FuncSingleDef]
funcDefs)
      | Just TestType
testType <- CommandLineOption -> Maybe TestType
parseTestType (LocatedN RdrName -> CommandLineOption
fromRdrName LocatedN RdrName
funcName) -> do
          Maybe SigInfo
mSigInfo <- ConvertTestM (Maybe SigInfo)
getLastSeenSig
          [[LHsDecl GhcPs]] -> [LHsDecl GhcPs]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[LHsDecl GhcPs]] -> [LHsDecl GhcPs])
-> StateT ConvertTestState Identity [[LHsDecl GhcPs]]
-> ConvertTestM [LHsDecl GhcPs]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Maybe SigInfo
 -> LocatedA FuncSingleDef -> ConvertTestM [LHsDecl GhcPs])
-> [Maybe SigInfo]
-> [LocatedA FuncSingleDef]
-> StateT ConvertTestState Identity [[LHsDecl GhcPs]]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (LocatedN RdrName
-> TestType
-> Maybe SigInfo
-> LocatedA FuncSingleDef
-> ConvertTestM [LHsDecl GhcPs]
forall e l ann.
Located e
-> TestType
-> Maybe SigInfo
-> GenLocated l FuncSingleDef
-> ConvertTestM [LHsDecl GhcPs]
convertSingleTest LocatedN RdrName
funcName TestType
testType) (Maybe SigInfo
mSigInfo Maybe SigInfo -> [Maybe SigInfo] -> [Maybe SigInfo]
forall a. a -> [a] -> [a]
: Maybe SigInfo -> [Maybe SigInfo]
forall a. a -> [a]
repeat Maybe SigInfo
forall a. Maybe a
Nothing) [LocatedA FuncSingleDef]
funcDefs
    -- anything else leave unmodified
    Maybe ParsedDecl
_ -> [LHsDecl GhcPs] -> ConvertTestM [LHsDecl GhcPs]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [LHsDecl GhcPs
ldecl]
  where
    loc :: SrcSpan
loc = LHsDecl GhcPs -> SrcSpan
forall e. Located e -> SrcSpan
getLocA LHsDecl GhcPs
ldecl

    convertSingleTest :: Located e
-> TestType
-> Maybe SigInfo
-> GenLocated l FuncSingleDef
-> ConvertTestM [LHsDecl GhcPs]
convertSingleTest Located e
funcName TestType
testType Maybe SigInfo
mSigInfo (L l
_ FuncSingleDef{[LPat GhcPs]
[FuncGuardedBody]
HsLocalBinds GhcPs
funcDefWhereClause :: FuncSingleDef -> HsLocalBinds GhcPs
funcDefGuards :: FuncSingleDef -> [FuncGuardedBody]
funcDefArgs :: FuncSingleDef -> [LPat GhcPs]
funcDefWhereClause :: HsLocalBinds GhcPs
funcDefGuards :: [FuncGuardedBody]
funcDefArgs :: [LPat GhcPs]
..}) = do
      (LocatedN RdrName
testName, Maybe (LHsSigWcType GhcPs)
mSigType) <-
        case Maybe SigInfo
mSigInfo of
          Maybe SigInfo
Nothing -> do
            LocatedN RdrName
testName <- ConvertTestM (LocatedN RdrName)
getNextTestName
            (LocatedN RdrName, Maybe (LHsSigWcType GhcPs))
-> StateT
     ConvertTestState
     Identity
     (LocatedN RdrName, Maybe (LHsSigWcType GhcPs))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LocatedN RdrName
testName, Maybe (LHsSigWcType GhcPs)
forall a. Maybe a
Nothing)
          Just SigInfo{testType :: SigInfo -> TestType
testType = TestType
testTypeFromSig, LHsSigWcType GhcPs
LocatedN RdrName
signatureType :: LHsSigWcType GhcPs
testName :: LocatedN RdrName
signatureType :: SigInfo -> LHsSigWcType GhcPs
testName :: SigInfo -> LocatedN RdrName
..}
            | TestType
testType TestType -> TestType -> Bool
forall a. Eq a => a -> a -> Bool
== TestType
testTypeFromSig -> (LocatedN RdrName, Maybe (LHsSigWcType GhcPs))
-> StateT
     ConvertTestState
     Identity
     (LocatedN RdrName, Maybe (LHsSigWcType GhcPs))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LocatedN RdrName
testName, LHsSigWcType GhcPs -> Maybe (LHsSigWcType GhcPs)
forall a. a -> Maybe a
Just LHsSigWcType GhcPs
signatureType)
            | Bool
otherwise -> CommandLineOption
-> StateT
     ConvertTestState
     Identity
     (LocatedN RdrName, Maybe (LHsSigWcType GhcPs))
forall a. CommandLineOption -> a
autocollectError (CommandLineOption
 -> StateT
      ConvertTestState
      Identity
      (LocatedN RdrName, Maybe (LHsSigWcType GhcPs)))
-> CommandLineOption
-> StateT
     ConvertTestState
     Identity
     (LocatedN RdrName, Maybe (LHsSigWcType GhcPs))
forall a b. (a -> b) -> a -> b
$ CommandLineOption
"Found test with different type of signature: " CommandLineOption -> CommandLineOption -> CommandLineOption
forall a. [a] -> [a] -> [a]
++ (TestType, TestType) -> CommandLineOption
forall a. Show a => a -> CommandLineOption
show (TestType
testType, TestType
testTypeFromSig)

      GenLocated SrcSpan (HsExpr GhcPs)
testBody <-
        case [FuncGuardedBody]
funcDefGuards of
          [FuncGuardedBody [] GenLocated SrcSpan (HsExpr GhcPs)
body] -> TestType
-> Maybe (LHsSigWcType GhcPs)
-> [Located (Pat GhcPs)]
-> GenLocated SrcSpan (HsExpr GhcPs)
-> StateT
     ConvertTestState Identity (GenLocated SrcSpan (HsExpr GhcPs))
forall (m :: * -> *).
Monad m =>
TestType
-> Maybe (LHsSigWcType GhcPs)
-> [Located (Pat GhcPs)]
-> GenLocated SrcSpan (HsExpr GhcPs)
-> m (GenLocated SrcSpan (HsExpr GhcPs))
convertSingleTestBody TestType
testType Maybe (LHsSigWcType GhcPs)
mSigType [LPat GhcPs]
[Located (Pat GhcPs)]
funcDefArgs GenLocated SrcSpan (HsExpr GhcPs)
body
          [FuncGuardedBody]
_ ->
            CommandLineOption
-> StateT
     ConvertTestState Identity (GenLocated SrcSpan (HsExpr GhcPs))
forall a. CommandLineOption -> a
autocollectError (CommandLineOption
 -> StateT
      ConvertTestState Identity (GenLocated SrcSpan (HsExpr GhcPs)))
-> ([CommandLineOption] -> CommandLineOption)
-> [CommandLineOption]
-> StateT
     ConvertTestState Identity (GenLocated SrcSpan (HsExpr GhcPs))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CommandLineOption] -> CommandLineOption
unlines ([CommandLineOption]
 -> StateT
      ConvertTestState Identity (GenLocated SrcSpan (HsExpr GhcPs)))
-> [CommandLineOption]
-> StateT
     ConvertTestState Identity (GenLocated SrcSpan (HsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$
              [ CommandLineOption
"Test should have no guards."
              , CommandLineOption
"Found guards at " CommandLineOption -> CommandLineOption -> CommandLineOption
forall a. [a] -> [a] -> [a]
++ SrcSpan -> CommandLineOption
getSpanLine (Located e -> SrcSpan
forall e. Located e -> SrcSpan
getLocA Located e
funcName)
              ]

      [LHsDecl GhcPs] -> ConvertTestM [LHsDecl GhcPs]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([LHsDecl GhcPs] -> ConvertTestM [LHsDecl GhcPs])
-> ([[LHsDecl GhcPs]] -> [LHsDecl GhcPs])
-> [[LHsDecl GhcPs]]
-> ConvertTestM [LHsDecl GhcPs]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[LHsDecl GhcPs]] -> [LHsDecl GhcPs]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[LHsDecl GhcPs]] -> ConvertTestM [LHsDecl GhcPs])
-> [[LHsDecl GhcPs]] -> ConvertTestM [LHsDecl GhcPs]
forall a b. (a -> b) -> a -> b
$
        [ if Maybe SigInfo -> Bool
forall a. Maybe a -> Bool
isNothing Maybe SigInfo
mSigInfo
            then [HsDecl GhcPs -> LHsDecl GhcPs
forall e ann. e -> GenLocated SrcSpan e
genLoc (HsDecl GhcPs -> LHsDecl GhcPs) -> HsDecl GhcPs -> LHsDecl GhcPs
forall a b. (a -> b) -> a -> b
$ LocatedN RdrName -> LHsType GhcPs -> HsDecl GhcPs
genFuncSig LocatedN RdrName
testName (ExternalNames -> LHsType GhcPs
getListOfTestTreeType ExternalNames
names)]
            else []
        , [LocatedN RdrName
-> [LPat GhcPs]
-> GenLocated SrcSpan (HsExpr GhcPs)
-> Maybe (HsLocalBinds GhcPs)
-> HsDecl GhcPs
genFuncDecl LocatedN RdrName
testName [] GenLocated SrcSpan (HsExpr GhcPs)
testBody (HsLocalBinds GhcPs -> Maybe (HsLocalBinds GhcPs)
forall a. a -> Maybe a
Just HsLocalBinds GhcPs
funcDefWhereClause) HsDecl GhcPs -> LHsDecl GhcPs -> LHsDecl GhcPs
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ LHsDecl GhcPs
ldecl]
        ]

    convertSingleTestBody :: TestType
-> Maybe (LHsSigWcType GhcPs)
-> [Located (Pat GhcPs)]
-> GenLocated SrcSpan (HsExpr GhcPs)
-> m (GenLocated SrcSpan (HsExpr GhcPs))
convertSingleTestBody TestType
testType Maybe (LHsSigWcType GhcPs)
mSigType [Located (Pat GhcPs)]
args GenLocated SrcSpan (HsExpr GhcPs)
body =
      case TestType
testType of
        TestType
TestNormal -> do
          TestType -> [Located (Pat GhcPs)] -> m ()
forall (f :: * -> *) (t :: * -> *) a.
(Applicative f, Foldable t) =>
TestType -> t a -> f ()
checkNoArgs TestType
testType [Located (Pat GhcPs)]
args
          GenLocated SrcSpan (HsExpr GhcPs)
-> m (GenLocated SrcSpan (HsExpr GhcPs))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GenLocated SrcSpan (HsExpr GhcPs)
 -> m (GenLocated SrcSpan (HsExpr GhcPs)))
-> GenLocated SrcSpan (HsExpr GhcPs)
-> m (GenLocated SrcSpan (HsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpan (HsExpr GhcPs)
-> GenLocated SrcSpan (HsExpr GhcPs)
forall ann.
GenLocated SrcSpan (HsExpr GhcPs)
-> GenLocated SrcSpan (HsExpr GhcPs)
singleExpr GenLocated SrcSpan (HsExpr GhcPs)
body
        TestType
TestProp -> do
          (CommandLineOption
name, [Located (Pat GhcPs)]
remainingPats) <-
            case [Located (Pat GhcPs)]
args of
              Located (Pat GhcPs)
arg : [Located (Pat GhcPs)]
rest | Just CommandLineOption
s <- LPat GhcPs -> Maybe CommandLineOption
parseLitStrPat LPat GhcPs
Located (Pat GhcPs)
arg -> (CommandLineOption, [Located (Pat GhcPs)])
-> m (CommandLineOption, [Located (Pat GhcPs)])
forall (m :: * -> *) a. Monad m => a -> m a
return (CommandLineOption
s, [Located (Pat GhcPs)]
rest)
              [] -> CommandLineOption -> m (CommandLineOption, [Located (Pat GhcPs)])
forall a. CommandLineOption -> a
autocollectError CommandLineOption
"test_prop requires at least the name of the test"
              Located (Pat GhcPs)
arg : [Located (Pat GhcPs)]
_ ->
                CommandLineOption -> m (CommandLineOption, [Located (Pat GhcPs)])
forall a. CommandLineOption -> a
autocollectError (CommandLineOption -> m (CommandLineOption, [Located (Pat GhcPs)]))
-> ([CommandLineOption] -> CommandLineOption)
-> [CommandLineOption]
-> m (CommandLineOption, [Located (Pat GhcPs)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CommandLineOption] -> CommandLineOption
unlines ([CommandLineOption]
 -> m (CommandLineOption, [Located (Pat GhcPs)]))
-> [CommandLineOption]
-> m (CommandLineOption, [Located (Pat GhcPs)])
forall a b. (a -> b) -> a -> b
$
                  [ CommandLineOption
"test_prop expected a String for the name of the test."
                  , CommandLineOption
"Got: " CommandLineOption -> CommandLineOption -> CommandLineOption
forall a. [a] -> [a] -> [a]
++ Located (Pat GhcPs) -> CommandLineOption
forall a. Outputable a => a -> CommandLineOption
showPpr Located (Pat GhcPs)
arg
                  ]
          let propBody :: GenLocated SrcSpan (HsExpr GhcPs)
propBody = [LPat GhcPs]
-> GenLocated SrcSpan (HsExpr GhcPs)
-> GenLocated SrcSpan (HsExpr GhcPs)
forall (p :: Pass).
(XMG (GhcPass p) (LHsExpr (GhcPass p)) ~ NoExtField) =>
[LPat (GhcPass p)] -> LHsExpr (GhcPass p) -> LHsExpr (GhcPass p)
mkHsLam [LPat GhcPs]
[Located (Pat GhcPs)]
remainingPats GenLocated SrcSpan (HsExpr GhcPs)
body
          GenLocated SrcSpan (HsExpr GhcPs)
-> m (GenLocated SrcSpan (HsExpr GhcPs))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GenLocated SrcSpan (HsExpr GhcPs)
 -> m (GenLocated SrcSpan (HsExpr GhcPs)))
-> (GenLocated SrcSpan (HsExpr GhcPs)
    -> GenLocated SrcSpan (HsExpr GhcPs))
-> GenLocated SrcSpan (HsExpr GhcPs)
-> m (GenLocated SrcSpan (HsExpr GhcPs))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpan (HsExpr GhcPs)
-> GenLocated SrcSpan (HsExpr GhcPs)
forall ann.
GenLocated SrcSpan (HsExpr GhcPs)
-> GenLocated SrcSpan (HsExpr GhcPs)
singleExpr (GenLocated SrcSpan (HsExpr GhcPs)
 -> m (GenLocated SrcSpan (HsExpr GhcPs)))
-> GenLocated SrcSpan (HsExpr GhcPs)
-> m (GenLocated SrcSpan (HsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$
            GenLocated SrcSpan (HsExpr GhcPs)
-> [GenLocated SrcSpan (HsExpr GhcPs)]
-> GenLocated SrcSpan (HsExpr GhcPs)
mkHsApps
              (LocatedN RdrName -> GenLocated SrcSpan (HsExpr GhcPs)
lhsvar (LocatedN RdrName -> GenLocated SrcSpan (HsExpr GhcPs))
-> LocatedN RdrName -> GenLocated SrcSpan (HsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ CommandLineOption -> LocatedN RdrName
mkLRdrName CommandLineOption
"testProperty")
              [ CommandLineOption -> GenLocated SrcSpan (HsExpr GhcPs)
mkHsLitString CommandLineOption
name
              , GenLocated SrcSpan (HsExpr GhcPs)
-> (LHsSigWcType GhcPs -> GenLocated SrcSpan (HsExpr GhcPs))
-> Maybe (LHsSigWcType GhcPs)
-> GenLocated SrcSpan (HsExpr GhcPs)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe GenLocated SrcSpan (HsExpr GhcPs)
propBody (HsExpr GhcPs -> GenLocated SrcSpan (HsExpr GhcPs)
forall e ann. e -> GenLocated SrcSpan e
genLoc (HsExpr GhcPs -> GenLocated SrcSpan (HsExpr GhcPs))
-> (LHsSigWcType GhcPs -> HsExpr GhcPs)
-> LHsSigWcType GhcPs
-> GenLocated SrcSpan (HsExpr GhcPs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XExprWithTySig GhcPs
-> GenLocated SrcSpan (HsExpr GhcPs)
-> LHsSigWcType (NoGhcTc GhcPs)
-> HsExpr GhcPs
forall p.
XExprWithTySig p
-> LHsExpr p -> LHsSigWcType (NoGhcTc p) -> HsExpr p
ExprWithTySig NoExtField
XExprWithTySig GhcPs
noAnn GenLocated SrcSpan (HsExpr GhcPs)
propBody) Maybe (LHsSigWcType GhcPs)
mSigType
              ]
        TestType
TestTodo -> do
          TestType -> [Located (Pat GhcPs)] -> m ()
forall (f :: * -> *) (t :: * -> *) a.
(Applicative f, Foldable t) =>
TestType -> t a -> f ()
checkNoArgs TestType
testType [Located (Pat GhcPs)]
args
          GenLocated SrcSpan (HsExpr GhcPs)
-> m (GenLocated SrcSpan (HsExpr GhcPs))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GenLocated SrcSpan (HsExpr GhcPs)
 -> m (GenLocated SrcSpan (HsExpr GhcPs)))
-> (GenLocated SrcSpan (HsExpr GhcPs)
    -> GenLocated SrcSpan (HsExpr GhcPs))
-> GenLocated SrcSpan (HsExpr GhcPs)
-> m (GenLocated SrcSpan (HsExpr GhcPs))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpan (HsExpr GhcPs)
-> GenLocated SrcSpan (HsExpr GhcPs)
forall ann.
GenLocated SrcSpan (HsExpr GhcPs)
-> GenLocated SrcSpan (HsExpr GhcPs)
singleExpr (GenLocated SrcSpan (HsExpr GhcPs)
 -> m (GenLocated SrcSpan (HsExpr GhcPs)))
-> GenLocated SrcSpan (HsExpr GhcPs)
-> m (GenLocated SrcSpan (HsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$
            GenLocated SrcSpan (HsExpr GhcPs)
-> GenLocated SrcSpan (HsExpr GhcPs)
-> GenLocated SrcSpan (HsExpr GhcPs)
forall (id :: Pass).
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
mkHsApp
              (Name -> GenLocated SrcSpan (HsExpr GhcPs)
mkHsVar (Name -> GenLocated SrcSpan (HsExpr GhcPs))
-> Name -> GenLocated SrcSpan (HsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ ExternalNames -> Name
name_testTreeTodo ExternalNames
names)
              (GenLocated SrcSpan (HsExpr GhcPs)
-> LHsType GhcPs -> GenLocated SrcSpan (HsExpr GhcPs)
mkExprTypeSig GenLocated SrcSpan (HsExpr GhcPs)
body (LHsType GhcPs -> GenLocated SrcSpan (HsExpr GhcPs))
-> LHsType GhcPs -> GenLocated SrcSpan (HsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ Name -> LHsType GhcPs
mkHsTyVar (ExternalNames -> Name
name_String ExternalNames
names))
        TestType
TestBatch -> do
          TestType -> [Located (Pat GhcPs)] -> m ()
forall (f :: * -> *) (t :: * -> *) a.
(Applicative f, Foldable t) =>
TestType -> t a -> f ()
checkNoArgs TestType
testType [Located (Pat GhcPs)]
args
          GenLocated SrcSpan (HsExpr GhcPs)
-> m (GenLocated SrcSpan (HsExpr GhcPs))
forall (f :: * -> *) a. Applicative f => a -> f a
pure GenLocated SrcSpan (HsExpr GhcPs)
body
        TestModify TestModifier
modifier TestType
testType' ->
          ExternalNames
-> TestModifier
-> SrcSpan
-> [LPat GhcPs]
-> ([LPat GhcPs] -> m (GenLocated SrcSpan (HsExpr GhcPs)))
-> m (GenLocated SrcSpan (HsExpr GhcPs))
forall (m :: * -> *).
Monad m =>
ExternalNames
-> TestModifier
-> SrcSpan
-> [LPat GhcPs]
-> ([LPat GhcPs] -> m (GenLocated SrcSpan (HsExpr GhcPs)))
-> m (GenLocated SrcSpan (HsExpr GhcPs))
withTestModifier ExternalNames
names TestModifier
modifier SrcSpan
loc [LPat GhcPs]
[Located (Pat GhcPs)]
args (([LPat GhcPs] -> m (GenLocated SrcSpan (HsExpr GhcPs)))
 -> m (GenLocated SrcSpan (HsExpr GhcPs)))
-> ([LPat GhcPs] -> m (GenLocated SrcSpan (HsExpr GhcPs)))
-> m (GenLocated SrcSpan (HsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$ \[LPat GhcPs]
args' ->
            TestType
-> Maybe (LHsSigWcType GhcPs)
-> [Located (Pat GhcPs)]
-> GenLocated SrcSpan (HsExpr GhcPs)
-> m (GenLocated SrcSpan (HsExpr GhcPs))
convertSingleTestBody TestType
testType' Maybe (LHsSigWcType GhcPs)
mSigType [LPat GhcPs]
[Located (Pat GhcPs)]
args' GenLocated SrcSpan (HsExpr GhcPs)
body

    singleExpr :: GenLocated SrcSpan (HsExpr GhcPs)
-> GenLocated SrcSpan (HsExpr GhcPs)
singleExpr = HsExpr GhcPs -> GenLocated SrcSpan (HsExpr GhcPs)
forall e ann. e -> GenLocated SrcSpan e
genLoc (HsExpr GhcPs -> GenLocated SrcSpan (HsExpr GhcPs))
-> (GenLocated SrcSpan (HsExpr GhcPs) -> HsExpr GhcPs)
-> GenLocated SrcSpan (HsExpr GhcPs)
-> GenLocated SrcSpan (HsExpr GhcPs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [GenLocated SrcSpan (HsExpr GhcPs)] -> HsExpr GhcPs
mkExplicitList ([GenLocated SrcSpan (HsExpr GhcPs)] -> HsExpr GhcPs)
-> (GenLocated SrcSpan (HsExpr GhcPs)
    -> [GenLocated SrcSpan (HsExpr GhcPs)])
-> GenLocated SrcSpan (HsExpr GhcPs)
-> HsExpr GhcPs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GenLocated SrcSpan (HsExpr GhcPs)
-> [GenLocated SrcSpan (HsExpr GhcPs)]
-> [GenLocated SrcSpan (HsExpr GhcPs)]
forall a. a -> [a] -> [a]
: [])

    checkNoArgs :: TestType -> t a -> f ()
checkNoArgs TestType
testType t a
args =
      Bool -> f () -> f ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (t a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null t a
args) (f () -> f ()) -> f () -> f ()
forall a b. (a -> b) -> a -> b
$
        CommandLineOption -> f ()
forall a. CommandLineOption -> a
autocollectError (CommandLineOption -> f ())
-> ([CommandLineOption] -> CommandLineOption)
-> [CommandLineOption]
-> f ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CommandLineOption] -> CommandLineOption
unwords ([CommandLineOption] -> f ()) -> [CommandLineOption] -> f ()
forall a b. (a -> b) -> a -> b
$
          [ TestType -> CommandLineOption
showTestType TestType
testType CommandLineOption -> CommandLineOption -> CommandLineOption
forall a. [a] -> [a] -> [a]
++ CommandLineOption
" should not be used with arguments"
          , CommandLineOption
"(at " CommandLineOption -> CommandLineOption -> CommandLineOption
forall a. [a] -> [a] -> [a]
++ SrcSpan -> CommandLineOption
getSpanLine SrcSpan
loc CommandLineOption -> CommandLineOption -> CommandLineOption
forall a. [a] -> [a] -> [a]
++ CommandLineOption
")"
          ]

-- | Identifier for the generated `tests` list.
testListName :: LocatedN RdrName
testListName :: LocatedN RdrName
testListName = CommandLineOption -> LocatedN RdrName
mkLRdrName CommandLineOption
testListIdentifier

-- | Return the `[TestTree]` type.
getListOfTestTreeType :: ExternalNames -> LHsType GhcPs
getListOfTestTreeType :: ExternalNames -> LHsType GhcPs
getListOfTestTreeType ExternalNames
names = HsType GhcPs -> LHsType GhcPs
forall e ann. e -> GenLocated SrcSpan e
genLoc (HsType GhcPs -> LHsType GhcPs) -> HsType GhcPs -> LHsType GhcPs
forall a b. (a -> b) -> a -> b
$ XListTy GhcPs -> LHsType GhcPs -> HsType GhcPs
forall pass. XListTy pass -> LHsType pass -> HsType pass
HsListTy NoExtField
XListTy GhcPs
noAnn (LHsType GhcPs -> HsType GhcPs) -> LHsType GhcPs -> HsType GhcPs
forall a b. (a -> b) -> a -> b
$ Name -> LHsType GhcPs
mkHsTyVar (ExternalNames -> Name
name_TestTree ExternalNames
names)

{----- TestType -----}

data TestType
  = TestNormal
  | TestProp
  | TestTodo
  | TestBatch
  | TestModify TestModifier TestType
  deriving (Int -> TestType -> CommandLineOption -> CommandLineOption
[TestType] -> CommandLineOption -> CommandLineOption
TestType -> CommandLineOption
(Int -> TestType -> CommandLineOption -> CommandLineOption)
-> (TestType -> CommandLineOption)
-> ([TestType] -> CommandLineOption -> CommandLineOption)
-> Show TestType
forall a.
(Int -> a -> CommandLineOption -> CommandLineOption)
-> (a -> CommandLineOption)
-> ([a] -> CommandLineOption -> CommandLineOption)
-> Show a
showList :: [TestType] -> CommandLineOption -> CommandLineOption
$cshowList :: [TestType] -> CommandLineOption -> CommandLineOption
show :: TestType -> CommandLineOption
$cshow :: TestType -> CommandLineOption
showsPrec :: Int -> TestType -> CommandLineOption -> CommandLineOption
$cshowsPrec :: Int -> TestType -> CommandLineOption -> CommandLineOption
Show, TestType -> TestType -> Bool
(TestType -> TestType -> Bool)
-> (TestType -> TestType -> Bool) -> Eq TestType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TestType -> TestType -> Bool
$c/= :: TestType -> TestType -> Bool
== :: TestType -> TestType -> Bool
$c== :: TestType -> TestType -> Bool
Eq)

data TestModifier
  = ExpectFail
  | ExpectFailBecause
  | IgnoreTest
  | IgnoreTestBecause
  deriving (Int -> TestModifier -> CommandLineOption -> CommandLineOption
[TestModifier] -> CommandLineOption -> CommandLineOption
TestModifier -> CommandLineOption
(Int -> TestModifier -> CommandLineOption -> CommandLineOption)
-> (TestModifier -> CommandLineOption)
-> ([TestModifier] -> CommandLineOption -> CommandLineOption)
-> Show TestModifier
forall a.
(Int -> a -> CommandLineOption -> CommandLineOption)
-> (a -> CommandLineOption)
-> ([a] -> CommandLineOption -> CommandLineOption)
-> Show a
showList :: [TestModifier] -> CommandLineOption -> CommandLineOption
$cshowList :: [TestModifier] -> CommandLineOption -> CommandLineOption
show :: TestModifier -> CommandLineOption
$cshow :: TestModifier -> CommandLineOption
showsPrec :: Int -> TestModifier -> CommandLineOption -> CommandLineOption
$cshowsPrec :: Int -> TestModifier -> CommandLineOption -> CommandLineOption
Show, TestModifier -> TestModifier -> Bool
(TestModifier -> TestModifier -> Bool)
-> (TestModifier -> TestModifier -> Bool) -> Eq TestModifier
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TestModifier -> TestModifier -> Bool
$c/= :: TestModifier -> TestModifier -> Bool
== :: TestModifier -> TestModifier -> Bool
$c== :: TestModifier -> TestModifier -> Bool
Eq)

parseTestType :: String -> Maybe TestType
parseTestType :: CommandLineOption -> Maybe TestType
parseTestType = [Text] -> Maybe TestType
go ([Text] -> Maybe TestType)
-> (CommandLineOption -> [Text])
-> CommandLineOption
-> Maybe TestType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> [Text]
Text.splitOn Text
"_" (Text -> [Text])
-> (CommandLineOption -> Text) -> CommandLineOption -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommandLineOption -> Text
Text.pack
  where
    go :: [Text] -> Maybe TestType
go = \case
      [Text
"test"] -> TestType -> Maybe TestType
forall a. a -> Maybe a
Just TestType
TestNormal
      [Text
"test", Text
"prop"] -> TestType -> Maybe TestType
forall a. a -> Maybe a
Just TestType
TestProp
      [Text
"test", Text
"todo"] -> TestType -> Maybe TestType
forall a. a -> Maybe a
Just TestType
TestTodo
      [Text
"test", Text
"batch"] -> TestType -> Maybe TestType
forall a. a -> Maybe a
Just TestType
TestBatch
      ([Text] -> Maybe ([Text], Text)
forall a. [a] -> Maybe ([a], a)
unsnoc -> Just ([Text]
t, Text
"expectFail")) -> TestModifier -> TestType -> TestType
TestModify TestModifier
ExpectFail (TestType -> TestType) -> Maybe TestType -> Maybe TestType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text] -> Maybe TestType
go [Text]
t
      ([Text] -> Maybe ([Text], Text)
forall a. [a] -> Maybe ([a], a)
unsnoc -> Just ([Text]
t, Text
"expectFailBecause")) -> TestModifier -> TestType -> TestType
TestModify TestModifier
ExpectFailBecause (TestType -> TestType) -> Maybe TestType -> Maybe TestType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text] -> Maybe TestType
go [Text]
t
      ([Text] -> Maybe ([Text], Text)
forall a. [a] -> Maybe ([a], a)
unsnoc -> Just ([Text]
t, Text
"ignoreTest")) -> TestModifier -> TestType -> TestType
TestModify TestModifier
IgnoreTest (TestType -> TestType) -> Maybe TestType -> Maybe TestType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text] -> Maybe TestType
go [Text]
t
      ([Text] -> Maybe ([Text], Text)
forall a. [a] -> Maybe ([a], a)
unsnoc -> Just ([Text]
t, Text
"ignoreTestBecause")) -> TestModifier -> TestType -> TestType
TestModify TestModifier
IgnoreTestBecause (TestType -> TestType) -> Maybe TestType -> Maybe TestType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text] -> Maybe TestType
go [Text]
t
      [Text]
_ -> Maybe TestType
forall a. Maybe a
Nothing

    unsnoc :: [a] -> Maybe ([a], a)
unsnoc = (NonEmpty a -> ([a], a)) -> Maybe (NonEmpty a) -> Maybe ([a], a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (NonEmpty a -> [a]
forall a. NonEmpty a -> [a]
NonEmpty.init (NonEmpty a -> [a]) -> (NonEmpty a -> a) -> NonEmpty a -> ([a], a)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& NonEmpty a -> a
forall a. NonEmpty a -> a
NonEmpty.last) (Maybe (NonEmpty a) -> Maybe ([a], a))
-> ([a] -> Maybe (NonEmpty a)) -> [a] -> Maybe ([a], a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Maybe (NonEmpty a)
forall a. [a] -> Maybe (NonEmpty a)
NonEmpty.nonEmpty

showTestType :: TestType -> String
showTestType :: TestType -> CommandLineOption
showTestType = \case
  TestType
TestNormal -> CommandLineOption
"test"
  TestType
TestProp -> CommandLineOption
"test_prop"
  TestType
TestTodo -> CommandLineOption
"test_todo"
  TestType
TestBatch -> CommandLineOption
"test_batch"
  TestModify TestModifier
modifier TestType
tt -> TestType -> CommandLineOption
showTestType TestType
tt CommandLineOption -> CommandLineOption -> CommandLineOption
forall a. [a] -> [a] -> [a]
++ TestModifier -> CommandLineOption
showModifier TestModifier
modifier
  where
    showModifier :: TestModifier -> CommandLineOption
showModifier = \case
      TestModifier
ExpectFail -> CommandLineOption
"_expectFail"
      TestModifier
ExpectFailBecause -> CommandLineOption
"_expectFailBecause"
      TestModifier
IgnoreTest -> CommandLineOption
"_ignoreTest"
      TestModifier
IgnoreTestBecause -> CommandLineOption
"_ignoreTestBecause"

isValidForTestType :: ExternalNames -> TestType -> LHsSigWcType GhcPs -> Bool
isValidForTestType :: ExternalNames -> TestType -> LHsSigWcType GhcPs -> Bool
isValidForTestType ExternalNames
names = \case
  TestType
TestNormal -> (ParsedType -> Bool) -> LHsSigWcType GhcPs -> Bool
parsedTypeMatches ParsedType -> Bool
isTestTreeTypeVar
  TestType
TestProp -> Bool -> LHsSigWcType GhcPs -> Bool
forall a b. a -> b -> a
const Bool
True
  TestType
TestTodo -> (ParsedType -> Bool) -> LHsSigWcType GhcPs -> Bool
parsedTypeMatches ((ParsedType -> Bool) -> LHsSigWcType GhcPs -> Bool)
-> (ParsedType -> Bool) -> LHsSigWcType GhcPs -> Bool
forall a b. (a -> b) -> a -> b
$ Name -> ParsedType -> Bool
isTypeVarNamed (ExternalNames -> Name
name_String ExternalNames
names)
  TestType
TestBatch -> (ParsedType -> Bool) -> LHsSigWcType GhcPs -> Bool
parsedTypeMatches ((ParsedType -> Bool) -> LHsSigWcType GhcPs -> Bool)
-> (ParsedType -> Bool) -> LHsSigWcType GhcPs -> Bool
forall a b. (a -> b) -> a -> b
$ \case
    TypeList ParsedType
ty -> ParsedType -> Bool
isTestTreeTypeVar ParsedType
ty
    ParsedType
_ -> Bool
False
  TestModify TestModifier
modifier TestType
tt -> TestType -> TestModifier -> LHsSigWcType GhcPs -> Bool
isValidForModifier TestType
tt TestModifier
modifier
  where
    isValidForModifier :: TestType -> TestModifier -> LHsSigWcType GhcPs -> Bool
isValidForModifier TestType
tt = \case
      TestModifier
ExpectFail -> ExternalNames -> TestType -> LHsSigWcType GhcPs -> Bool
isValidForTestType ExternalNames
names TestType
tt
      TestModifier
ExpectFailBecause -> ExternalNames -> TestType -> LHsSigWcType GhcPs -> Bool
isValidForTestType ExternalNames
names TestType
tt
      TestModifier
IgnoreTest -> ExternalNames -> TestType -> LHsSigWcType GhcPs -> Bool
isValidForTestType ExternalNames
names TestType
tt
      TestModifier
IgnoreTestBecause -> ExternalNames -> TestType -> LHsSigWcType GhcPs -> Bool
isValidForTestType ExternalNames
names TestType
tt

    parsedTypeMatches :: (ParsedType -> Bool) -> LHsSigWcType GhcPs -> Bool
parsedTypeMatches ParsedType -> Bool
f = Bool -> (ParsedType -> Bool) -> Maybe ParsedType -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False ParsedType -> Bool
f (Maybe ParsedType -> Bool)
-> (LHsSigWcType GhcPs -> Maybe ParsedType)
-> LHsSigWcType GhcPs
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsSigWcType GhcPs -> Maybe ParsedType
parseSigWcType
    isTestTreeTypeVar :: ParsedType -> Bool
isTestTreeTypeVar = Name -> ParsedType -> Bool
isTypeVarNamed (ExternalNames -> Name
name_TestTree ExternalNames
names)

typeForTestType :: TestType -> String
typeForTestType :: TestType -> CommandLineOption
typeForTestType = \case
  TestType
TestNormal -> CommandLineOption
"TestTree"
  TestType
TestProp -> CommandLineOption
"(Testable prop => prop)"
  TestType
TestTodo -> CommandLineOption
"String"
  TestType
TestBatch -> CommandLineOption
"[TestTree]"
  TestModify TestModifier
modifier TestType
tt -> TestType -> TestModifier -> CommandLineOption
typeForTestModifier TestType
tt TestModifier
modifier
  where
    typeForTestModifier :: TestType -> TestModifier -> CommandLineOption
typeForTestModifier TestType
tt = \case
      TestModifier
ExpectFail -> TestType -> CommandLineOption
typeForTestType TestType
tt
      TestModifier
ExpectFailBecause -> TestType -> CommandLineOption
typeForTestType TestType
tt
      TestModifier
IgnoreTest -> TestType -> CommandLineOption
typeForTestType TestType
tt
      TestModifier
IgnoreTestBecause -> TestType -> CommandLineOption
typeForTestType TestType
tt

isTypeVarNamed :: Name -> ParsedType -> Bool
isTypeVarNamed :: Name -> ParsedType -> Bool
isTypeVarNamed Name
name = \case
  TypeVar PromotionFlag
_ (L SrcSpan
_ RdrName
n) -> RdrName -> OccName
rdrNameOcc RdrName
n OccName -> OccName -> Bool
forall a. Eq a => a -> a -> Bool
== RdrName -> OccName
rdrNameOcc (Name -> RdrName
forall thing. NamedThing thing => thing -> RdrName
getRdrName Name
name)
  ParsedType
_ -> Bool
False

withTestModifier ::
  Monad m =>
  ExternalNames ->
  TestModifier ->
  SrcSpan ->
  [LPat GhcPs] ->
  ([LPat GhcPs] -> m (LHsExpr GhcPs)) ->
  m (LHsExpr GhcPs)
withTestModifier :: ExternalNames
-> TestModifier
-> SrcSpan
-> [LPat GhcPs]
-> ([LPat GhcPs] -> m (GenLocated SrcSpan (HsExpr GhcPs)))
-> m (GenLocated SrcSpan (HsExpr GhcPs))
withTestModifier ExternalNames
names TestModifier
modifier SrcSpan
loc [LPat GhcPs]
args [LPat GhcPs] -> m (GenLocated SrcSpan (HsExpr GhcPs))
f =
  case TestModifier
modifier of
    TestModifier
ExpectFail -> GenLocated SrcSpan (HsExpr GhcPs)
-> GenLocated SrcSpan (HsExpr GhcPs)
-> GenLocated SrcSpan (HsExpr GhcPs)
mapAllTests (Name -> GenLocated SrcSpan (HsExpr GhcPs)
mkHsVar (Name -> GenLocated SrcSpan (HsExpr GhcPs))
-> Name -> GenLocated SrcSpan (HsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ ExternalNames -> Name
name_expectFail ExternalNames
names) (GenLocated SrcSpan (HsExpr GhcPs)
 -> GenLocated SrcSpan (HsExpr GhcPs))
-> m (GenLocated SrcSpan (HsExpr GhcPs))
-> m (GenLocated SrcSpan (HsExpr GhcPs))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LPat GhcPs] -> m (GenLocated SrcSpan (HsExpr GhcPs))
f [LPat GhcPs]
args
    TestModifier
ExpectFailBecause ->
      case [LPat GhcPs]
args of
        LPat GhcPs
arg : [LPat GhcPs]
rest
          | Just CommandLineOption
s <- LPat GhcPs -> Maybe CommandLineOption
parseLitStrPat LPat GhcPs
arg ->
              GenLocated SrcSpan (HsExpr GhcPs)
-> GenLocated SrcSpan (HsExpr GhcPs)
-> GenLocated SrcSpan (HsExpr GhcPs)
mapAllTests (Name
-> [GenLocated SrcSpan (HsExpr GhcPs)]
-> GenLocated SrcSpan (HsExpr GhcPs)
applyName (ExternalNames -> Name
name_expectFailBecause ExternalNames
names) [CommandLineOption -> GenLocated SrcSpan (HsExpr GhcPs)
mkHsLitString CommandLineOption
s]) (GenLocated SrcSpan (HsExpr GhcPs)
 -> GenLocated SrcSpan (HsExpr GhcPs))
-> m (GenLocated SrcSpan (HsExpr GhcPs))
-> m (GenLocated SrcSpan (HsExpr GhcPs))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LPat GhcPs] -> m (GenLocated SrcSpan (HsExpr GhcPs))
f [LPat GhcPs]
rest
        [LPat GhcPs]
_ -> CommandLineOption -> m (GenLocated SrcSpan (HsExpr GhcPs))
forall a. CommandLineOption -> a
needsStrArg CommandLineOption
"_expectFailBecause"
    TestModifier
IgnoreTest -> GenLocated SrcSpan (HsExpr GhcPs)
-> GenLocated SrcSpan (HsExpr GhcPs)
-> GenLocated SrcSpan (HsExpr GhcPs)
mapAllTests (Name -> GenLocated SrcSpan (HsExpr GhcPs)
mkHsVar (Name -> GenLocated SrcSpan (HsExpr GhcPs))
-> Name -> GenLocated SrcSpan (HsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ ExternalNames -> Name
name_ignoreTest ExternalNames
names) (GenLocated SrcSpan (HsExpr GhcPs)
 -> GenLocated SrcSpan (HsExpr GhcPs))
-> m (GenLocated SrcSpan (HsExpr GhcPs))
-> m (GenLocated SrcSpan (HsExpr GhcPs))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LPat GhcPs] -> m (GenLocated SrcSpan (HsExpr GhcPs))
f [LPat GhcPs]
args
    TestModifier
IgnoreTestBecause ->
      case [LPat GhcPs]
args of
        LPat GhcPs
arg : [LPat GhcPs]
rest
          | Just CommandLineOption
s <- LPat GhcPs -> Maybe CommandLineOption
parseLitStrPat LPat GhcPs
arg ->
              GenLocated SrcSpan (HsExpr GhcPs)
-> GenLocated SrcSpan (HsExpr GhcPs)
-> GenLocated SrcSpan (HsExpr GhcPs)
mapAllTests (Name
-> [GenLocated SrcSpan (HsExpr GhcPs)]
-> GenLocated SrcSpan (HsExpr GhcPs)
applyName (ExternalNames -> Name
name_ignoreTestBecause ExternalNames
names) [CommandLineOption -> GenLocated SrcSpan (HsExpr GhcPs)
mkHsLitString CommandLineOption
s]) (GenLocated SrcSpan (HsExpr GhcPs)
 -> GenLocated SrcSpan (HsExpr GhcPs))
-> m (GenLocated SrcSpan (HsExpr GhcPs))
-> m (GenLocated SrcSpan (HsExpr GhcPs))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LPat GhcPs] -> m (GenLocated SrcSpan (HsExpr GhcPs))
f [LPat GhcPs]
rest
        [LPat GhcPs]
_ -> CommandLineOption -> m (GenLocated SrcSpan (HsExpr GhcPs))
forall a. CommandLineOption -> a
needsStrArg CommandLineOption
"_ignoreTestBecause"
  where
    needsStrArg :: CommandLineOption -> c
needsStrArg CommandLineOption
label =
      CommandLineOption -> c
forall a. CommandLineOption -> a
autocollectError (CommandLineOption -> c)
-> ([[CommandLineOption]] -> CommandLineOption)
-> [[CommandLineOption]]
-> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CommandLineOption] -> CommandLineOption
unlines ([CommandLineOption] -> CommandLineOption)
-> ([[CommandLineOption]] -> [CommandLineOption])
-> [[CommandLineOption]]
-> CommandLineOption
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[CommandLineOption]] -> [CommandLineOption]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[CommandLineOption]] -> c) -> [[CommandLineOption]] -> c
forall a b. (a -> b) -> a -> b
$
        [ [CommandLineOption
label CommandLineOption -> CommandLineOption -> CommandLineOption
forall a. [a] -> [a] -> [a]
++ CommandLineOption
" requires a String argument."]
        , case [LPat GhcPs]
args of
            [] -> []
            LPat GhcPs
arg : [LPat GhcPs]
_ -> [CommandLineOption
"Got: " CommandLineOption -> CommandLineOption -> CommandLineOption
forall a. [a] -> [a] -> [a]
++ Located (Pat GhcPs) -> CommandLineOption
forall a. Outputable a => a -> CommandLineOption
showPpr LPat GhcPs
Located (Pat GhcPs)
arg]
        , [CommandLineOption
"At: " CommandLineOption -> CommandLineOption -> CommandLineOption
forall a. [a] -> [a] -> [a]
++ SrcSpan -> CommandLineOption
getSpanLine SrcSpan
loc]
        ]

    applyName :: Name
-> [GenLocated SrcSpan (HsExpr GhcPs)]
-> GenLocated SrcSpan (HsExpr GhcPs)
applyName Name
name = GenLocated SrcSpan (HsExpr GhcPs)
-> [GenLocated SrcSpan (HsExpr GhcPs)]
-> GenLocated SrcSpan (HsExpr GhcPs)
mkHsApps (Name -> GenLocated SrcSpan (HsExpr GhcPs)
mkHsVar Name
name)

    -- mapAllTests f e = [| map $f $e |]
    mapAllTests :: GenLocated SrcSpan (HsExpr GhcPs)
-> GenLocated SrcSpan (HsExpr GhcPs)
-> GenLocated SrcSpan (HsExpr GhcPs)
mapAllTests GenLocated SrcSpan (HsExpr GhcPs)
func GenLocated SrcSpan (HsExpr GhcPs)
expr = Name
-> [GenLocated SrcSpan (HsExpr GhcPs)]
-> GenLocated SrcSpan (HsExpr GhcPs)
applyName (ExternalNames -> Name
name_map ExternalNames
names) [GenLocated SrcSpan (HsExpr GhcPs)
func, GenLocated SrcSpan (HsExpr GhcPs)
expr]

{----- Test converter monad -----}

type ConvertTestM = State ConvertTestState

data ConvertTestState = ConvertTestState
  { ConvertTestState -> Maybe SigInfo
lastSeenSig :: Maybe SigInfo
  , ConvertTestState -> Seq (LocatedN RdrName)
allTests :: Seq (LocatedN RdrName)
  }

data SigInfo = SigInfo
  { SigInfo -> TestType
testType :: TestType
  -- ^ The type of test represented in this signature
  , SigInfo -> LocatedN RdrName
testName :: LocatedN RdrName
  -- ^ The generated name for the test
  , SigInfo -> LHsSigWcType GhcPs
signatureType :: LHsSigWcType GhcPs
  -- ^ The type captured in the signature
  }

runConvertTestM :: ConvertTestM a -> (a, [LocatedN RdrName])
runConvertTestM :: ConvertTestM a -> (a, [LocatedN RdrName])
runConvertTestM ConvertTestM a
m =
  (ConvertTestState -> [LocatedN RdrName])
-> (a, ConvertTestState) -> (a, [LocatedN RdrName])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Seq (LocatedN RdrName) -> [LocatedN RdrName]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Seq (LocatedN RdrName) -> [LocatedN RdrName])
-> (ConvertTestState -> Seq (LocatedN RdrName))
-> ConvertTestState
-> [LocatedN RdrName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConvertTestState -> Seq (LocatedN RdrName)
allTests) ((a, ConvertTestState) -> (a, [LocatedN RdrName]))
-> (ConvertTestState -> (a, ConvertTestState))
-> ConvertTestState
-> (a, [LocatedN RdrName])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConvertTestM a -> ConvertTestState -> (a, ConvertTestState)
forall s a. State s a -> s -> (a, s)
State.runState ConvertTestM a
m (ConvertTestState -> (a, [LocatedN RdrName]))
-> ConvertTestState -> (a, [LocatedN RdrName])
forall a b. (a -> b) -> a -> b
$
    ConvertTestState :: Maybe SigInfo -> Seq (LocatedN RdrName) -> ConvertTestState
ConvertTestState
      { lastSeenSig :: Maybe SigInfo
lastSeenSig = Maybe SigInfo
forall a. Maybe a
Nothing
      , allTests :: Seq (LocatedN RdrName)
allTests = Seq (LocatedN RdrName)
forall a. Seq a
Seq.Empty
      }

getLastSeenSig :: ConvertTestM (Maybe SigInfo)
getLastSeenSig :: ConvertTestM (Maybe SigInfo)
getLastSeenSig = do
  state :: ConvertTestState
state@ConvertTestState{Maybe SigInfo
lastSeenSig :: Maybe SigInfo
lastSeenSig :: ConvertTestState -> Maybe SigInfo
lastSeenSig} <- StateT ConvertTestState Identity ConvertTestState
forall (m :: * -> *) s. Monad m => StateT s m s
State.get
  ConvertTestState -> ConvertTestM ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
State.put ConvertTestState
state{lastSeenSig :: Maybe SigInfo
lastSeenSig = Maybe SigInfo
forall a. Maybe a
Nothing}
  Maybe SigInfo -> ConvertTestM (Maybe SigInfo)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe SigInfo
lastSeenSig

setLastSeenSig :: SigInfo -> ConvertTestM ()
setLastSeenSig :: SigInfo -> ConvertTestM ()
setLastSeenSig SigInfo
info = (ConvertTestState -> ConvertTestState) -> ConvertTestM ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
State.modify' ((ConvertTestState -> ConvertTestState) -> ConvertTestM ())
-> (ConvertTestState -> ConvertTestState) -> ConvertTestM ()
forall a b. (a -> b) -> a -> b
$ \ConvertTestState
state -> ConvertTestState
state{lastSeenSig :: Maybe SigInfo
lastSeenSig = SigInfo -> Maybe SigInfo
forall a. a -> Maybe a
Just SigInfo
info}

getNextTestName :: ConvertTestM (LocatedN RdrName)
getNextTestName :: ConvertTestM (LocatedN RdrName)
getNextTestName = do
  state :: ConvertTestState
state@ConvertTestState{Seq (LocatedN RdrName)
allTests :: Seq (LocatedN RdrName)
allTests :: ConvertTestState -> Seq (LocatedN RdrName)
allTests} <- StateT ConvertTestState Identity ConvertTestState
forall (m :: * -> *) s. Monad m => StateT s m s
State.get
  let nextTestName :: LocatedN RdrName
nextTestName = CommandLineOption -> LocatedN RdrName
mkLRdrName (CommandLineOption -> LocatedN RdrName)
-> CommandLineOption -> LocatedN RdrName
forall a b. (a -> b) -> a -> b
$ Int -> CommandLineOption
testIdentifier (Seq (LocatedN RdrName) -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq (LocatedN RdrName)
allTests)
  ConvertTestState -> ConvertTestM ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
State.put ConvertTestState
state{allTests :: Seq (LocatedN RdrName)
allTests = Seq (LocatedN RdrName)
allTests Seq (LocatedN RdrName)
-> LocatedN RdrName -> Seq (LocatedN RdrName)
forall a. Seq a -> a -> Seq a
Seq.|> LocatedN RdrName
nextTestName}
  LocatedN RdrName -> ConvertTestM (LocatedN RdrName)
forall (f :: * -> *) a. Applicative f => a -> f a
pure LocatedN RdrName
nextTestName

{----- Utilities -----}

concatMapM :: Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM :: (a -> m [b]) -> [a] -> m [b]
concatMapM a -> m [b]
f = ([[b]] -> [b]) -> m [[b]] -> m [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[b]] -> [b]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (m [[b]] -> m [b]) -> ([a] -> m [[b]]) -> [a] -> m [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> m [b]) -> [a] -> m [[b]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM a -> m [b]
f