{-# OPTIONS_GHC -cpp -pgmP "cpphs --layout --hashes --cpp" #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE PackageImports #-}
{- |
Internal module providing access to some functionality of cpphs.
-}
--
-- Copyright (c) 2009-2022 Stefan Wehr - http://www.stefanwehr.de
--
-- This library is free software; you can redistribute it and/or
-- modify it under the terms of the GNU Lesser General Public
-- License as published by the Free Software Foundation; either
-- version 2.1 of the License, or (at your option) any later version.
--
-- This library is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-- Lesser General Public License for more details.
--
-- You should have received a copy of the GNU Lesser General Public
-- License along with this library; if not, write to the Free Software
-- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA
--

module Test.Framework.Preprocessor (

    transform, progName, preprocessorTests, TransformOptions(..)

) where

-- import Debug.Trace
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))]

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 } -- lex as haskell
    }

data TransformOptions = TransformOptions { TransformOptions -> Bool
debug :: Bool
                                         , TransformOptions -> Bool
literateTex :: Bool }

transform :: TransformOptions -> FilePath -> String -> IO String
transform :: TransformOptions -> String -> String -> IO String
transform (TransformOptions 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 serves two purposes:
      -- 1. add a trailing \n
      -- 2. turn lines of the form '# <number> "<filename>"' into line directives '#line <number> <filename>'
      -- (see http://gcc.gnu.org/onlinedocs/cpp/Preprocessor-Output.html#Preprocessor-Output).
      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]
++
                                    ModuleInfo -> [(String, String)]
nameDefines ModuleInfo
info
                              , boolopts :: BoolOptions
boolopts = (CpphsOptions -> BoolOptions
boolopts CpphsOptions
defaultCpphsOptions) { lang :: Bool
lang = Bool
True } -- lex as haskell
                              }
      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

-- Returns for lines of the form '# <number> "<filename>"'
-- (see http://gcc.gnu.org/onlinedocs/cpp/Preprocessor-Output.html#Preprocessor-Output)
-- the value 'Just <number> "<filename>"'
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)]