{-# OPTIONS_GHC -cpp -pgmP "cpphs --layout --hashes --cpp" #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE PackageImports #-}
module Test.Framework.Preprocessor (
transform, progName, preprocessorTests, TransformOptions(..)
) where
import Control.Monad
import Data.Char
import Language.Preprocessor.Cpphs ( runCpphsPass1,
runCpphsPass2,
CpphsOptions(..),
BoolOptions(..),
defaultCpphsOptions,
WordStyle(..),
Posn,
filename,
lineno,
newfile,
tokenise
)
import System.IO ( hPutStrLn, stderr )
#if MIN_VERSION_HUnit(1,4,0)
import Test.HUnit hiding (State)
#else
import Test.HUnit hiding (State, Location)
#endif
import Control.Monad.State.Strict
import qualified Data.List as List
import Data.Maybe
import Test.Framework.Location
_DEBUG_ :: Bool
_DEBUG_ :: Bool
_DEBUG_ = Bool
False
progName :: String
progName :: String
progName = String
"htfpp"
htfModule :: String
htfModule :: String
htfModule = String
"Test.Framework"
mkName :: String -> String -> String
mkName String
varName String
fullModuleName =
String
"htf_" String -> String -> String
forall a. [a] -> [a] -> [a]
++
(Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map (\Char
c -> if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.' then Char
'_' else Char
c)
(String
fullModuleName String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"." String -> String -> String
forall a. [a] -> [a] -> [a]
++
(case String
varName of
Char
'h':Char
't':Char
'f':Char
'_':String
s -> String
s
String
s -> String
s))
thisModulesTestsFullName :: String -> String
thisModulesTestsFullName :: String -> String
thisModulesTestsFullName = String -> String -> String
mkName String
thisModulesTestsName
importedTestListFullName :: String -> String
importedTestListFullName :: String -> String
importedTestListFullName = String -> String -> String
mkName String
importedTestListName
thisModulesTestsName :: String
thisModulesTestsName :: String
thisModulesTestsName = String
"htf_thisModulesTests"
importedTestListName :: String
importedTestListName :: String
importedTestListName = String
"htf_importedTests"
nameDefines :: ModuleInfo -> [(String, String)]
nameDefines :: ModuleInfo -> [(String, String)]
nameDefines ModuleInfo
info =
[(String
thisModulesTestsName, String -> String
thisModulesTestsFullName (ModuleInfo -> String
mi_moduleNameWithDefault ModuleInfo
info)),
(String
importedTestListName, String -> String
importedTestListFullName (ModuleInfo -> String
mi_moduleNameWithDefault ModuleInfo
info))]
allAsserts :: [String]
allAsserts :: [String]
allAsserts =
[String] -> [String]
forall (t :: * -> *). Foldable t => t String -> [String]
withGs [String
"assertBool"
,String
"assertEqual"
,String
"assertEqualPretty"
,String
"assertEqualNoShow"
,String
"assertNotEqual"
,String
"assertNotEqualPretty"
,String
"assertNotEqualNoShow"
,String
"assertListsEqualAsSets"
,String
"assertElem"
,String
"assertEmpty"
,String
"assertNotEmpty"
,String
"assertLeft"
,String
"assertLeftNoShow"
,String
"assertRight"
,String
"assertRightNoShow"
,String
"assertJust"
,String
"assertNothing"
,String
"assertNothingNoShow"
,String
"subAssert"
,String
"subAssertVerbose"
] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"assertThrows"
,String
"assertThrowsSome"
,String
"assertThrowsIO"
,String
"assertThrowsSomeIO"
,String
"assertThrowsM"
,String
"assertThrowsSomeM"]
where
withGs :: t String -> [String]
withGs t String
l =
(String -> [String]) -> t String -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\String
s -> [String
s, Char
'g'Char -> String -> String
forall a. a -> [a] -> [a]
:String
s]) t String
l
assertDefines :: Bool -> String -> [(String, String)]
assertDefines :: Bool -> String -> [(String, String)]
assertDefines Bool
hunitBackwardsCompat String
prefix =
(String -> [(String, String)]) -> [String] -> [(String, String)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap String -> [(String, String)]
fun [String]
allAsserts [(String, String)] -> [(String, String)] -> [(String, String)]
forall a. [a] -> [a] -> [a]
++ [(String
"assertFailure", String -> String -> String
expansion String
"assertFailure" String
"_")]
where
fun :: String -> [(String, String)]
fun String
a =
if Bool
hunitBackwardsCompat
then [(String
a, String -> String -> String
expansion String
a String
"Verbose_"), (String
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"HTF", String -> String -> String
expansion String
a String
"_")]
else [(String
a, String -> String -> String
expansion String
a String
"_"), (String
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"Verbose", String -> String -> String
expansion String
a String
"Verbose_")]
expansion :: String -> String -> String
expansion String
a String
suffix = String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
prefix String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suffix String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" (" String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
prefix String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"makeLoc __FILE__ __LINE__))"
data ModuleInfo = ModuleInfo { ModuleInfo -> String
mi_htfPrefix :: String
, ModuleInfo -> [ImportDecl]
mi_htfImports :: [ImportDecl]
, ModuleInfo -> [Definition]
mi_defs :: [Definition]
, ModuleInfo -> Maybe String
mi_moduleName :: Maybe String }
deriving (Int -> ModuleInfo -> String -> String
[ModuleInfo] -> String -> String
ModuleInfo -> String
(Int -> ModuleInfo -> String -> String)
-> (ModuleInfo -> String)
-> ([ModuleInfo] -> String -> String)
-> Show ModuleInfo
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [ModuleInfo] -> String -> String
$cshowList :: [ModuleInfo] -> String -> String
show :: ModuleInfo -> String
$cshow :: ModuleInfo -> String
showsPrec :: Int -> ModuleInfo -> String -> String
$cshowsPrec :: Int -> ModuleInfo -> String -> String
Show, ModuleInfo -> ModuleInfo -> Bool
(ModuleInfo -> ModuleInfo -> Bool)
-> (ModuleInfo -> ModuleInfo -> Bool) -> Eq ModuleInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModuleInfo -> ModuleInfo -> Bool
$c/= :: ModuleInfo -> ModuleInfo -> Bool
== :: ModuleInfo -> ModuleInfo -> Bool
$c== :: ModuleInfo -> ModuleInfo -> Bool
Eq)
mi_moduleNameWithDefault :: ModuleInfo -> String
mi_moduleNameWithDefault :: ModuleInfo -> String
mi_moduleNameWithDefault = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"Main" (Maybe String -> String)
-> (ModuleInfo -> Maybe String) -> ModuleInfo -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleInfo -> Maybe String
mi_moduleName
data ImportDecl = ImportDecl { ImportDecl -> String
imp_moduleName :: Name
, ImportDecl -> Bool
imp_qualified :: Bool
, ImportDecl -> Maybe String
imp_alias :: Maybe Name
, ImportDecl -> Location
imp_loc :: Location }
deriving (Int -> ImportDecl -> String -> String
[ImportDecl] -> String -> String
ImportDecl -> String
(Int -> ImportDecl -> String -> String)
-> (ImportDecl -> String)
-> ([ImportDecl] -> String -> String)
-> Show ImportDecl
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [ImportDecl] -> String -> String
$cshowList :: [ImportDecl] -> String -> String
show :: ImportDecl -> String
$cshow :: ImportDecl -> String
showsPrec :: Int -> ImportDecl -> String -> String
$cshowsPrec :: Int -> ImportDecl -> String -> String
Show, ImportDecl -> ImportDecl -> Bool
(ImportDecl -> ImportDecl -> Bool)
-> (ImportDecl -> ImportDecl -> Bool) -> Eq ImportDecl
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImportDecl -> ImportDecl -> Bool
$c/= :: ImportDecl -> ImportDecl -> Bool
== :: ImportDecl -> ImportDecl -> Bool
$c== :: ImportDecl -> ImportDecl -> Bool
Eq)
data Definition = TestDef String Location String
| PropDef String Location String
deriving (Definition -> Definition -> Bool
(Definition -> Definition -> Bool)
-> (Definition -> Definition -> Bool) -> Eq Definition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Definition -> Definition -> Bool
$c/= :: Definition -> Definition -> Bool
== :: Definition -> Definition -> Bool
$c== :: Definition -> Definition -> Bool
Eq, Int -> Definition -> String -> String
[Definition] -> String -> String
Definition -> String
(Int -> Definition -> String -> String)
-> (Definition -> String)
-> ([Definition] -> String -> String)
-> Show Definition
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Definition] -> String -> String
$cshowList :: [Definition] -> String -> String
show :: Definition -> String
$cshow :: Definition -> String
showsPrec :: Int -> Definition -> String -> String
$cshowsPrec :: Int -> Definition -> String -> String
Show)
type Name = String
type PMA a = State ModuleInfo a
setModName :: String -> PMA ()
setModName :: String -> PMA ()
setModName String
name =
do Maybe String
oldName <- (ModuleInfo -> Maybe String)
-> StateT ModuleInfo Identity (Maybe String)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ModuleInfo -> Maybe String
mi_moduleName
Bool -> PMA () -> PMA ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe String -> Bool
forall a. Maybe a -> Bool
isNothing Maybe String
oldName) (PMA () -> PMA ()) -> PMA () -> PMA ()
forall a b. (a -> b) -> a -> b
$ (ModuleInfo -> ModuleInfo) -> PMA ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((ModuleInfo -> ModuleInfo) -> PMA ())
-> (ModuleInfo -> ModuleInfo) -> PMA ()
forall a b. (a -> b) -> a -> b
$ \ModuleInfo
mi -> ModuleInfo
mi { mi_moduleName :: Maybe String
mi_moduleName = String -> Maybe String
forall a. a -> Maybe a
Just String
name }
addTestDef :: String -> String -> Location -> PMA ()
addTestDef :: String -> String -> Location -> PMA ()
addTestDef String
name String
fullName Location
loc =
(ModuleInfo -> ModuleInfo) -> PMA ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((ModuleInfo -> ModuleInfo) -> PMA ())
-> (ModuleInfo -> ModuleInfo) -> PMA ()
forall a b. (a -> b) -> a -> b
$ \ModuleInfo
mi -> ModuleInfo
mi { mi_defs :: [Definition]
mi_defs = (String -> Location -> String -> Definition
TestDef String
name Location
loc String
fullName) Definition -> [Definition] -> [Definition]
forall a. a -> [a] -> [a]
: ModuleInfo -> [Definition]
mi_defs ModuleInfo
mi }
addPropDef :: String -> String -> Location -> PMA ()
addPropDef :: String -> String -> Location -> PMA ()
addPropDef String
name String
fullName Location
loc =
(ModuleInfo -> ModuleInfo) -> PMA ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((ModuleInfo -> ModuleInfo) -> PMA ())
-> (ModuleInfo -> ModuleInfo) -> PMA ()
forall a b. (a -> b) -> a -> b
$ \ModuleInfo
mi -> ModuleInfo
mi { mi_defs :: [Definition]
mi_defs = (String -> Location -> String -> Definition
PropDef String
name Location
loc String
fullName) Definition -> [Definition] -> [Definition]
forall a. a -> [a] -> [a]
: ModuleInfo -> [Definition]
mi_defs ModuleInfo
mi }
addHtfImport :: ImportDecl -> PMA ()
addHtfImport :: ImportDecl -> PMA ()
addHtfImport ImportDecl
decl =
(ModuleInfo -> ModuleInfo) -> PMA ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((ModuleInfo -> ModuleInfo) -> PMA ())
-> (ModuleInfo -> ModuleInfo) -> PMA ()
forall a b. (a -> b) -> a -> b
$ \ModuleInfo
mi -> ModuleInfo
mi { mi_htfImports :: [ImportDecl]
mi_htfImports = ImportDecl
decl ImportDecl -> [ImportDecl] -> [ImportDecl]
forall a. a -> [a] -> [a]
: ModuleInfo -> [ImportDecl]
mi_htfImports ModuleInfo
mi }
setTestFrameworkImport :: String -> PMA ()
setTestFrameworkImport :: String -> PMA ()
setTestFrameworkImport String
name =
(ModuleInfo -> ModuleInfo) -> PMA ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((ModuleInfo -> ModuleInfo) -> PMA ())
-> (ModuleInfo -> ModuleInfo) -> PMA ()
forall a b. (a -> b) -> a -> b
$ \ModuleInfo
mi -> ModuleInfo
mi { mi_htfPrefix :: String
mi_htfPrefix = String
name }
data Tok
= TokModule
| TokQname Location String
| TokName Location Bool String
| TokHtfImport Location
| TokImport Location
transWordStyles :: [WordStyle] -> [Tok]
transWordStyles :: [WordStyle] -> [Tok]
transWordStyles [WordStyle]
styles = [WordStyle] -> Bool -> [Tok]
loop [WordStyle]
styles Bool
True
where
loop :: [WordStyle] -> Bool -> [Tok]
loop [WordStyle]
styles Bool
startOfLine =
case [WordStyle]
styles of
[] -> []
Ident Posn
pos String
name : [WordStyle]
rest ->
case String
name of
String
"module" -> Tok
TokModule Tok -> [Tok] -> [Tok]
forall a. a -> [a] -> [a]
: [WordStyle] -> Bool -> [Tok]
loop [WordStyle]
rest Bool
False
String
"import" ->
case [WordStyle] -> [WordStyle]
dropWhite [WordStyle]
rest of
Other String
"{-@ HTF_TESTS @-}" : [WordStyle]
rest2 ->
Location -> Tok
TokHtfImport (Posn -> Location
posToLocation Posn
pos) Tok -> [Tok] -> [Tok]
forall a. a -> [a] -> [a]
: [WordStyle] -> Bool -> [Tok]
loop [WordStyle]
rest2 Bool
False
[WordStyle]
_ ->
Location -> Tok
TokImport (Posn -> Location
posToLocation Posn
pos) Tok -> [Tok] -> [Tok]
forall a. a -> [a] -> [a]
: [WordStyle] -> Bool -> [Tok]
loop [WordStyle]
rest Bool
False
String
_ ->
case [WordStyle] -> ([String], [WordStyle])
parseQname [WordStyle]
rest of
([], [WordStyle]
rest2) ->
Location -> Bool -> String -> Tok
TokName (Posn -> Location
posToLocation Posn
pos) Bool
startOfLine String
name Tok -> [Tok] -> [Tok]
forall a. a -> [a] -> [a]
: [WordStyle] -> Bool -> [Tok]
loop [WordStyle]
rest2 Bool
False
([String]
nameParts, [WordStyle]
rest2) ->
Location -> String -> Tok
TokQname (Posn -> Location
posToLocation Posn
pos) (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
List.intercalate String
"." (String
nameString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
nameParts)) Tok -> [Tok] -> [Tok]
forall a. a -> [a] -> [a]
: [WordStyle] -> Bool -> [Tok]
loop [WordStyle]
rest2 Bool
False
Other String
str : [WordStyle]
rest ->
let startOfLine :: Bool
startOfLine =
case String -> String
forall a. [a] -> [a]
reverse String
str of
Char
'\n':String
_ -> Bool
True
String
_ -> Bool
False
in [WordStyle] -> Bool -> [Tok]
loop [WordStyle]
rest Bool
startOfLine
Cmd Maybe HashDefine
_ : [WordStyle]
rest -> [WordStyle] -> Bool -> [Tok]
loop [WordStyle]
rest Bool
False
dropWhite :: [WordStyle] -> [WordStyle]
dropWhite [WordStyle]
styles =
case [WordStyle]
styles of
Other String
str : [WordStyle]
rest ->
case (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace String
str of
[] -> [WordStyle] -> [WordStyle]
dropWhite [WordStyle]
rest
String
str' -> String -> WordStyle
Other String
str' WordStyle -> [WordStyle] -> [WordStyle]
forall a. a -> [a] -> [a]
: [WordStyle]
rest
[WordStyle]
_ -> [WordStyle]
styles
parseQname :: [WordStyle] -> ([String], [WordStyle])
parseQname [WordStyle]
styles =
case [WordStyle]
styles of
Other String
"." : Ident Posn
_ String
name : [WordStyle]
rest ->
let ([String]
restParts, [WordStyle]
rest2) = [WordStyle] -> ([String], [WordStyle])
parseQname [WordStyle]
rest
in (String
nameString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
restParts, [WordStyle]
rest2)
[WordStyle]
_ -> ([], [WordStyle]
styles)
posToLocation :: Posn -> Location
posToLocation Posn
pos = String -> Int -> Location
makeLoc (Posn -> String
filename Posn
pos) (Posn -> Int
lineno Posn
pos)
poorManAnalyzeTokens :: [WordStyle] -> ModuleInfo
poorManAnalyzeTokens :: [WordStyle] -> ModuleInfo
poorManAnalyzeTokens [WordStyle]
styles =
let toks :: [Tok]
toks = [WordStyle] -> [Tok]
transWordStyles [WordStyle]
styles
revRes :: ModuleInfo
revRes =
PMA () -> ModuleInfo -> ModuleInfo
forall s a. State s a -> s -> s
execState ([Tok] -> PMA ()
loop [Tok]
toks) (ModuleInfo -> ModuleInfo) -> ModuleInfo -> ModuleInfo
forall a b. (a -> b) -> a -> b
$
ModuleInfo :: String
-> [ImportDecl] -> [Definition] -> Maybe String -> ModuleInfo
ModuleInfo { mi_htfPrefix :: String
mi_htfPrefix = String
htfModule String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"."
, mi_htfImports :: [ImportDecl]
mi_htfImports = []
, mi_defs :: [Definition]
mi_defs = []
, mi_moduleName :: Maybe String
mi_moduleName = Maybe String
forall a. Maybe a
Nothing }
in ModuleInfo :: String
-> [ImportDecl] -> [Definition] -> Maybe String -> ModuleInfo
ModuleInfo { mi_htfPrefix :: String
mi_htfPrefix = ModuleInfo -> String
mi_htfPrefix ModuleInfo
revRes
, mi_htfImports :: [ImportDecl]
mi_htfImports = [ImportDecl] -> [ImportDecl]
forall a. [a] -> [a]
reverse (ModuleInfo -> [ImportDecl]
mi_htfImports ModuleInfo
revRes)
, mi_defs :: [Definition]
mi_defs = [Definition] -> [Definition]
forall a. [a] -> [a]
reverse ([Definition] -> [Definition]) -> [Definition] -> [Definition]
forall a b. (a -> b) -> a -> b
$ (Definition -> Definition -> Bool) -> [Definition] -> [Definition]
forall a. (a -> a -> Bool) -> [a] -> [a]
List.nubBy Definition -> Definition -> Bool
defEqByName (ModuleInfo -> [Definition]
mi_defs ModuleInfo
revRes)
, mi_moduleName :: Maybe String
mi_moduleName = ModuleInfo -> Maybe String
mi_moduleName ModuleInfo
revRes
}
where
defEqByName :: Definition -> Definition -> Bool
defEqByName (TestDef String
n1 Location
_ String
_) (TestDef String
n2 Location
_ String
_) = String
n1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
n2
defEqByName (PropDef String
n1 Location
_ String
_) (PropDef String
n2 Location
_ String
_) = String
n1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
n2
defEqByName Definition
_ Definition
_ = Bool
False
loop :: [Tok] -> PMA ()
loop [Tok]
toks =
case [Tok]
toks of
Tok
TokModule : TokQname Location
_ String
name : [Tok]
rest ->
do String -> PMA ()
setModName String
name
[Tok] -> PMA ()
loop [Tok]
rest
Tok
TokModule : TokName Location
_ Bool
_ String
name : [Tok]
rest ->
do String -> PMA ()
setModName String
name
[Tok] -> PMA ()
loop [Tok]
rest
TokName Location
loc Bool
startOfLine String
name : [Tok]
rest
| Bool
startOfLine ->
case String
name of
Char
't':Char
'e':Char
's':Char
't':Char
'_':String
shortName ->
do String -> String -> Location -> PMA ()
addTestDef String
shortName String
name Location
loc
[Tok] -> PMA ()
loop [Tok]
rest
Char
'p':Char
'r':Char
'o':Char
'p':Char
'_':String
shortName ->
do String -> String -> Location -> PMA ()
addPropDef String
shortName String
name Location
loc
[Tok] -> PMA ()
loop [Tok]
rest
String
_ -> [Tok] -> PMA ()
loop [Tok]
rest
| Bool
otherwise -> [Tok] -> PMA ()
loop [Tok]
rest
TokHtfImport Location
loc : [Tok]
rest ->
case Location -> [Tok] -> Maybe (ImportDecl, [Tok])
forall (m :: * -> *).
MonadFail m =>
Location -> [Tok] -> m (ImportDecl, [Tok])
parseImport Location
loc [Tok]
rest of
Just (ImportDecl
imp, [Tok]
rest2) ->
do ImportDecl -> PMA ()
addHtfImport ImportDecl
imp
[Tok] -> PMA ()
loop [Tok]
rest2
Maybe (ImportDecl, [Tok])
Nothing -> [Tok] -> PMA ()
loop [Tok]
rest
TokImport Location
loc : [Tok]
rest ->
do case Location -> [Tok] -> Maybe (ImportDecl, [Tok])
forall (m :: * -> *).
MonadFail m =>
Location -> [Tok] -> m (ImportDecl, [Tok])
parseImport Location
loc [Tok]
rest of
Maybe (ImportDecl, [Tok])
Nothing -> [Tok] -> PMA ()
loop [Tok]
rest
Just (ImportDecl
imp, [Tok]
rest2) ->
do Bool -> PMA () -> PMA ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ImportDecl -> String
imp_moduleName ImportDecl
imp String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
htfModule) (PMA () -> PMA ()) -> PMA () -> PMA ()
forall a b. (a -> b) -> a -> b
$
let prefix :: String
prefix = case (ImportDecl -> Maybe String
imp_alias ImportDecl
imp, ImportDecl -> Bool
imp_qualified ImportDecl
imp) of
(Just String
alias, Bool
True) -> String
alias
(Maybe String
Nothing, Bool
True) -> ImportDecl -> String
imp_moduleName ImportDecl
imp
(Maybe String, Bool)
_ -> String
""
in String -> PMA ()
setTestFrameworkImport
(if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
prefix then String
prefix else String
prefix String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".")
[Tok] -> PMA ()
loop [Tok]
rest2
Tok
_ : [Tok]
rest -> [Tok] -> PMA ()
loop [Tok]
rest
[] -> () -> PMA ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
parseImport :: Location -> [Tok] -> m (ImportDecl, [Tok])
parseImport Location
loc [Tok]
toks =
do let (Bool
qualified, [Tok]
toks2) =
case [Tok]
toks of
TokName _ _ "qualified" : rest -> (Bool
True, [Tok]
rest)
[Tok]
_ -> (Bool
False, [Tok]
toks)
(String
name, [Tok]
toks3) <-
case [Tok]
toks2 of
TokName Location
_ Bool
_ String
name : [Tok]
rest -> (String, [Tok]) -> m (String, [Tok])
forall (m :: * -> *) a. Monad m => a -> m a
return (String
name, [Tok]
rest)
TokQname Location
_ String
name : [Tok]
rest -> (String, [Tok]) -> m (String, [Tok])
forall (m :: * -> *) a. Monad m => a -> m a
return (String
name, [Tok]
rest)
[Tok]
_ -> String -> m (String, [Tok])
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"no import"
let (Maybe String
mAlias, [Tok]
toks4) =
case [Tok]
toks3 of
TokName Location
_ Bool
_ String
"as" : TokName Location
_ Bool
_ String
alias : [Tok]
rest -> (String -> Maybe String
forall a. a -> Maybe a
Just String
alias, [Tok]
rest)
[Tok]
_ -> (Maybe String
forall a. Maybe a
Nothing, [Tok]
toks3)
decl :: ImportDecl
decl = ImportDecl :: String -> Bool -> Maybe String -> Location -> ImportDecl
ImportDecl { imp_moduleName :: String
imp_moduleName = String
name
, imp_qualified :: Bool
imp_qualified = Bool
qualified
, imp_alias :: Maybe String
imp_alias = Maybe String
mAlias
, imp_loc :: Location
imp_loc = Location
loc }
(ImportDecl, [Tok]) -> m (ImportDecl, [Tok])
forall (m :: * -> *) a. Monad m => a -> m a
return (ImportDecl
decl, [Tok]
toks4)
analyze :: FilePath -> String -> IO (ModuleInfo, [WordStyle], [(Posn,String)])
analyze :: String -> String -> IO (ModuleInfo, [WordStyle], [(Posn, String)])
analyze String
originalFileName String
input =
do [(Posn, String)]
xs <- CpphsOptions -> String -> String -> IO [(Posn, String)]
runCpphsPass1 CpphsOptions
cpphsOptions String
originalFileName String
input
let bopts :: BoolOptions
bopts = CpphsOptions -> BoolOptions
boolopts CpphsOptions
cpphsOptions
toks :: [WordStyle]
toks = Bool -> Bool -> Bool -> Bool -> [(Posn, String)] -> [WordStyle]
tokenise (BoolOptions -> Bool
stripEol BoolOptions
bopts) (BoolOptions -> Bool
stripC89 BoolOptions
bopts) (BoolOptions -> Bool
ansi BoolOptions
bopts) (BoolOptions -> Bool
lang BoolOptions
bopts) ((String -> Posn
newfile String
"preDefined",String
"")(Posn, String) -> [(Posn, String)] -> [(Posn, String)]
forall a. a -> [a] -> [a]
:[(Posn, String)]
xs)
mi :: ModuleInfo
mi = [WordStyle] -> ModuleInfo
poorManAnalyzeTokens [WordStyle]
toks
(ModuleInfo, [WordStyle], [(Posn, String)])
-> IO (ModuleInfo, [WordStyle], [(Posn, String)])
forall (m :: * -> *) a. Monad m => a -> m a
return (ModuleInfo
mi, [WordStyle]
toks, [(Posn, String)]
xs)
analyzeTests :: [(String, ModuleInfo)]
analyzeTests =
[([String] -> String
unlines [String
"module FOO where"
,String
"import Test.Framework"
,String
"import {-@ HTF_TESTS @-} qualified Foo as Bar"
,String
"import {-@ HTF_TESTS @-} qualified Foo.X as Egg"
,String
"import {-@ HTF_TESTS @-} Foo.Y as Spam"
,String
"import {-@ HTF_TESTS @-} Foo.Z"
,String
"import {-@ HTF_TESTS @-} Baz"
,String
"deriveSafeCopy 1 'base ''T"
,String
"$(deriveSafeCopy 2 'extension ''T)"
,String
"test_blub test_foo = 1"
,String
"test_blah test_foo = '\''"
,String
"prop_abc prop_foo = 2"
,String
"prop_xyz = True"]
,ModuleInfo :: String
-> [ImportDecl] -> [Definition] -> Maybe String -> ModuleInfo
ModuleInfo { mi_htfPrefix :: String
mi_htfPrefix = String
""
, mi_htfImports :: [ImportDecl]
mi_htfImports =
[ImportDecl :: String -> Bool -> Maybe String -> Location -> ImportDecl
ImportDecl { imp_moduleName :: String
imp_moduleName = String
"Foo"
, imp_qualified :: Bool
imp_qualified = Bool
True
, imp_alias :: Maybe String
imp_alias = String -> Maybe String
forall a. a -> Maybe a
Just String
"Bar"
, imp_loc :: Location
imp_loc = String -> Int -> Location
makeLoc String
"<input>" Int
3}
,ImportDecl :: String -> Bool -> Maybe String -> Location -> ImportDecl
ImportDecl { imp_moduleName :: String
imp_moduleName = String
"Foo.X"
, imp_qualified :: Bool
imp_qualified = Bool
True
, imp_alias :: Maybe String
imp_alias = String -> Maybe String
forall a. a -> Maybe a
Just String
"Egg"
, imp_loc :: Location
imp_loc = String -> Int -> Location
makeLoc String
"<input>" Int
4}
,ImportDecl :: String -> Bool -> Maybe String -> Location -> ImportDecl
ImportDecl { imp_moduleName :: String
imp_moduleName = String
"Foo.Y"
, imp_qualified :: Bool
imp_qualified = Bool
False
, imp_alias :: Maybe String
imp_alias = String -> Maybe String
forall a. a -> Maybe a
Just String
"Spam"
, imp_loc :: Location
imp_loc = String -> Int -> Location
makeLoc String
"<input>" Int
5}
,ImportDecl :: String -> Bool -> Maybe String -> Location -> ImportDecl
ImportDecl { imp_moduleName :: String
imp_moduleName = String
"Foo.Z"
, imp_qualified :: Bool
imp_qualified = Bool
False
, imp_alias :: Maybe String
imp_alias = Maybe String
forall a. Maybe a
Nothing
, imp_loc :: Location
imp_loc = String -> Int -> Location
makeLoc String
"<input>" Int
6}
,ImportDecl :: String -> Bool -> Maybe String -> Location -> ImportDecl
ImportDecl { imp_moduleName :: String
imp_moduleName = String
"Baz"
, imp_qualified :: Bool
imp_qualified = Bool
False
, imp_alias :: Maybe String
imp_alias = Maybe String
forall a. Maybe a
Nothing
, imp_loc :: Location
imp_loc = String -> Int -> Location
makeLoc String
"<input>" Int
7}]
, mi_moduleName :: Maybe String
mi_moduleName = String -> Maybe String
forall a. a -> Maybe a
Just String
"FOO"
, mi_defs :: [Definition]
mi_defs = [String -> Location -> String -> Definition
TestDef String
"blub" (String -> Int -> Location
makeLoc String
"<input>" Int
10) String
"test_blub"
,String -> Location -> String -> Definition
TestDef String
"blah" (String -> Int -> Location
makeLoc String
"<input>" Int
11) String
"test_blah"
,String -> Location -> String -> Definition
PropDef String
"abc" (String -> Int -> Location
makeLoc String
"<input>" Int
12) String
"prop_abc"
,String -> Location -> String -> Definition
PropDef String
"xyz" (String -> Int -> Location
makeLoc String
"<input>" Int
13) String
"prop_xyz"]
})
,([String] -> String
unlines [String
"module Foo.Bar where"
,String
"import Test.Framework as Blub"
,String
"prop_xyz = True"]
,ModuleInfo :: String
-> [ImportDecl] -> [Definition] -> Maybe String -> ModuleInfo
ModuleInfo { mi_htfPrefix :: String
mi_htfPrefix = String
""
, mi_htfImports :: [ImportDecl]
mi_htfImports = []
, mi_moduleName :: Maybe String
mi_moduleName = String -> Maybe String
forall a. a -> Maybe a
Just String
"Foo.Bar"
, mi_defs :: [Definition]
mi_defs = [String -> Location -> String -> Definition
PropDef String
"xyz" (String -> Int -> Location
makeLoc String
"<input>" Int
3) String
"prop_xyz"]
})
,([String] -> String
unlines [String
"module Foo.Bar where"
,String
"import qualified Test.Framework as Blub"
,String
"prop_xyz = True"]
,ModuleInfo :: String
-> [ImportDecl] -> [Definition] -> Maybe String -> ModuleInfo
ModuleInfo { mi_htfPrefix :: String
mi_htfPrefix = String
"Blub."
, mi_htfImports :: [ImportDecl]
mi_htfImports = []
, mi_moduleName :: Maybe String
mi_moduleName = String -> Maybe String
forall a. a -> Maybe a
Just String
"Foo.Bar"
, mi_defs :: [Definition]
mi_defs = [String -> Location -> String -> Definition
PropDef String
"xyz" (String -> Int -> Location
makeLoc String
"<input>" Int
3) String
"prop_xyz"]
})
,([String] -> String
unlines [String
"module Foo.Bar where"
,String
"import qualified Test.Framework"
,String
"prop_xyz = True"]
,ModuleInfo :: String
-> [ImportDecl] -> [Definition] -> Maybe String -> ModuleInfo
ModuleInfo { mi_htfPrefix :: String
mi_htfPrefix = String
"Test.Framework."
, mi_htfImports :: [ImportDecl]
mi_htfImports = []
, mi_moduleName :: Maybe String
mi_moduleName = String -> Maybe String
forall a. a -> Maybe a
Just String
"Foo.Bar"
, mi_defs :: [Definition]
mi_defs = [String -> Location -> String -> Definition
PropDef String
"xyz" (String -> Int -> Location
makeLoc String
"<input>" Int
3) String
"prop_xyz"]
})]
testAnalyze :: IO ()
testAnalyze =
do ((Integer, (String, ModuleInfo)) -> IO ())
-> [(Integer, (String, ModuleInfo))] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Integer, (String, ModuleInfo)) -> IO ()
forall a. Show a => (a, (String, ModuleInfo)) -> IO ()
runTest ([Integer]
-> [(String, ModuleInfo)] -> [(Integer, (String, ModuleInfo))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
1..] [(String, ModuleInfo)]
analyzeTests)
where
runTest :: (a, (String, ModuleInfo)) -> IO ()
runTest (a
i, (String
src, ModuleInfo
mi)) =
do (ModuleInfo
givenMi, [WordStyle]
_, [(Posn, String)]
_) <- String -> String -> IO (ModuleInfo, [WordStyle], [(Posn, String)])
analyze String
"<input>" String
src
if ModuleInfo
givenMi ModuleInfo -> ModuleInfo -> Bool
forall a. Eq a => a -> a -> Bool
== ModuleInfo
mi
then () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
else String -> IO ()
forall a. HasCallStack => String -> IO a
assertFailure (String
"Error in test " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
i String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
", expected:\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ModuleInfo -> String
forall a. Show a => a -> String
show ModuleInfo
mi String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"\nGiven:\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ModuleInfo -> String
forall a. Show a => a -> String
show ModuleInfo
givenMi String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"\nSrc:\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
src)
cpphsOptions :: CpphsOptions
cpphsOptions :: CpphsOptions
cpphsOptions =
CpphsOptions
defaultCpphsOptions {
boolopts :: BoolOptions
boolopts = (CpphsOptions -> BoolOptions
boolopts CpphsOptions
defaultCpphsOptions) { lang :: Bool
lang = Bool
True }
}
data TransformOptions = TransformOptions { TransformOptions -> Bool
hunitBackwardsCompat :: Bool
, TransformOptions -> Bool
debug :: Bool
, TransformOptions -> Bool
literateTex :: Bool }
transform :: TransformOptions -> FilePath -> String -> IO String
transform :: TransformOptions -> String -> String -> IO String
transform (TransformOptions Bool
hunitBackwardsCompat Bool
debug Bool
literateTex) String
originalFileName String
input =
do (ModuleInfo
info, [WordStyle]
toks, [(Posn, String)]
pass1) <- String -> String -> IO (ModuleInfo, [WordStyle], [(Posn, String)])
analyze String
originalFileName String
fixedInput
ModuleInfo -> [WordStyle] -> [(Posn, String)] -> IO String
forall a.
Show a =>
ModuleInfo -> a -> [(Posn, String)] -> IO String
preprocess ModuleInfo
info [WordStyle]
toks [(Posn, String)]
pass1
where
preprocess :: ModuleInfo -> a -> [(Posn, String)] -> IO String
preprocess ModuleInfo
info a
toks [(Posn, String)]
pass1 =
do Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
debug (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
do Handle -> String -> IO ()
hPutStrLn Handle
stderr (String
"Tokens: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
toks)
Handle -> String -> IO ()
hPutStrLn Handle
stderr (String
"Module info:\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ModuleInfo -> String
forall a. Show a => a -> String
show ModuleInfo
info)
let opts :: CpphsOptions
opts = ModuleInfo -> CpphsOptions
mkOptionsForModule ModuleInfo
info
String
preProcessedInput <-
BoolOptions
-> [(String, String)] -> String -> [(Posn, String)] -> IO String
runCpphsPass2 (CpphsOptions -> BoolOptions
boolopts CpphsOptions
opts) (CpphsOptions -> [(String, String)]
defines CpphsOptions
opts) String
originalFileName [(Posn, String)]
pass1
String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ String
preProcessedInput String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Bool -> String -> String
possiblyWrap Bool
literateTex (ModuleInfo -> String
additionalCode ModuleInfo
info) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n"
fixedInput :: String
fixedInput :: String
fixedInput = ([String] -> String
unlines ([String] -> String) -> (String -> [String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
fixLine ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines) String
input
where
fixLine :: String -> String
fixLine String
s =
case String -> Maybe (String, String)
parseCppLineInfoOut String
s of
Just (String
line, String
fileName) -> String
"#line " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
line String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fileName
Maybe (String, String)
_ -> String
s
mkOptionsForModule :: ModuleInfo -> CpphsOptions
mkOptionsForModule :: ModuleInfo -> CpphsOptions
mkOptionsForModule ModuleInfo
info =
CpphsOptions
defaultCpphsOptions { defines :: [(String, String)]
defines =
CpphsOptions -> [(String, String)]
defines CpphsOptions
defaultCpphsOptions [(String, String)] -> [(String, String)] -> [(String, String)]
forall a. [a] -> [a] -> [a]
++
Bool -> String -> [(String, String)]
assertDefines Bool
hunitBackwardsCompat (ModuleInfo -> String
mi_htfPrefix ModuleInfo
info) [(String, String)] -> [(String, String)] -> [(String, String)]
forall a. [a] -> [a] -> [a]
++
ModuleInfo -> [(String, String)]
nameDefines ModuleInfo
info
, boolopts :: BoolOptions
boolopts = (CpphsOptions -> BoolOptions
boolopts CpphsOptions
defaultCpphsOptions) { lang :: Bool
lang = Bool
True }
}
possiblyWrap :: Bool -> String -> String
possiblyWrap :: Bool -> String -> String
possiblyWrap Bool
b String
s = if Bool
b then String
"\\begin{code}\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\\end{code}" else String
s
additionalCode :: ModuleInfo -> String
additionalCode :: ModuleInfo -> String
additionalCode ModuleInfo
info =
String -> String
thisModulesTestsFullName (ModuleInfo -> String
mi_moduleNameWithDefault ModuleInfo
info) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" :: " String -> String -> String
forall a. [a] -> [a] -> [a]
++
ModuleInfo -> String
mi_htfPrefix ModuleInfo
info String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"TestSuite\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
String -> String
thisModulesTestsFullName (ModuleInfo -> String
mi_moduleNameWithDefault ModuleInfo
info) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" = " String -> String -> String
forall a. [a] -> [a] -> [a]
++
ModuleInfo -> String
mi_htfPrefix ModuleInfo
info String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"makeTestSuite" String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show (ModuleInfo -> String
mi_moduleNameWithDefault ModuleInfo
info) String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
" [\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
List.intercalate String
",\n"
((Definition -> String) -> [Definition] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Definition -> String
codeForDef (ModuleInfo -> String
mi_htfPrefix ModuleInfo
info)) (ModuleInfo -> [Definition]
mi_defs ModuleInfo
info))
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n ]\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ModuleInfo -> String
importedTestListCode ModuleInfo
info
codeForDef :: String -> Definition -> String
codeForDef :: String -> Definition -> String
codeForDef String
pref (TestDef String
s Location
loc String
name) =
Location -> String
locPragma Location
loc String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
pref String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"makeUnitTest " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (String -> String
forall a. Show a => a -> String
show String
s) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> Location -> String
codeForLoc String
pref Location
loc String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name
codeForDef String
pref (PropDef String
s Location
loc String
name) =
Location -> String
locPragma Location
loc String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
pref String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"makeQuickCheckTest " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (String -> String
forall a. Show a => a -> String
show String
s) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++
String -> Location -> String
codeForLoc String
pref Location
loc String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
pref String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"qcAssertion " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
locPragma :: Location -> String
locPragma :: Location -> String
locPragma Location
loc =
String
"{-# LINE " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Location -> Int
lineNumber Location
loc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show (Location -> String
fileName Location
loc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" #-}\n "
codeForLoc :: String -> Location -> String
codeForLoc :: String -> Location -> String
codeForLoc String
pref Location
loc = String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
pref String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"makeLoc " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show (Location -> String
fileName Location
loc) String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Location -> Int
lineNumber Location
loc) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
importedTestListCode :: ModuleInfo -> String
importedTestListCode :: ModuleInfo -> String
importedTestListCode ModuleInfo
info =
let l :: [ImportDecl]
l = ModuleInfo -> [ImportDecl]
mi_htfImports ModuleInfo
info
in case [ImportDecl]
l of
[] -> String
""
[ImportDecl]
_ -> (String -> String
importedTestListFullName (ModuleInfo -> String
mi_moduleNameWithDefault ModuleInfo
info)
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" :: [" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ModuleInfo -> String
mi_htfPrefix ModuleInfo
info String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"TestSuite]\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
String -> String
importedTestListFullName (ModuleInfo -> String
mi_moduleNameWithDefault ModuleInfo
info)
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" = [\n " String -> String -> String
forall a. [a] -> [a] -> [a]
++
String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
List.intercalate String
",\n " ((ImportDecl -> String) -> [ImportDecl] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ImportDecl -> String
htfTestsInModule [ImportDecl]
l) String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"\n ]\n")
htfTestsInModule :: ImportDecl -> String
htfTestsInModule :: ImportDecl -> String
htfTestsInModule ImportDecl
imp = ImportDecl -> String -> String
qualify ImportDecl
imp (String -> String
thisModulesTestsFullName (ImportDecl -> String
imp_moduleName ImportDecl
imp))
qualify :: ImportDecl -> String -> String
qualify :: ImportDecl -> String -> String
qualify ImportDecl
imp String
name =
case (ImportDecl -> Bool
imp_qualified ImportDecl
imp, ImportDecl -> Maybe String
imp_alias ImportDecl
imp) of
(Bool
False, Maybe String
_) -> String
name
(Bool
True, Just String
alias) -> String
alias String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name
(Bool
True, Maybe String
_) -> ImportDecl -> String
imp_moduleName ImportDecl
imp String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name
parseCppLineInfoOut :: String -> Maybe (String, String)
parseCppLineInfoOut :: String -> Maybe (String, String)
parseCppLineInfoOut String
line =
case String
line of
Char
'#':Char
' ':Char
c:String
rest
| Char -> Bool
isDigit Char
c ->
case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
List.span Char -> Bool
isDigit String
rest of
(String
restDigits, Char
' ' : Char
'"' : String
rest) ->
case (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'"') (String -> String
forall a. [a] -> [a]
reverse String
rest) of
Char
'"' : String
fileNameRev ->
let line :: String
line = (Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:String
restDigits)
file :: String
file = String
"\"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. [a] -> [a]
reverse String
fileNameRev String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\""
in (String, String) -> Maybe (String, String)
forall a. a -> Maybe a
Just (String
line, String
file)
String
_ -> Maybe (String, String)
forall a. Maybe a
Nothing
(String, String)
_ -> Maybe (String, String)
forall a. Maybe a
Nothing
String
_ -> Maybe (String, String)
forall a. Maybe a
Nothing
preprocessorTests :: [(String, IO ())]
preprocessorTests =
[(String
"testAnalyze", IO ()
testAnalyze)]