module Shaker.Type
where
import Data.Monoid
import Data.List
import Distribution.Simple.LocalBuildInfo
import Distribution.Simple.PackageIndex
import DynFlags hiding (OneShot)
import qualified Data.Map as M
import Control.Monad.Reader
import System.Time
import Control.Concurrent.MVar
import Control.Concurrent
type Shaker = ReaderT ShakerInput
type ShakerR = Reader ShakerInput
type ThreadIdList = MVar [ThreadId]
type Token = MVar Int
type CurrentFiles = MVar [FileInfo]
type MvModifiedFiles = MVar [FileInfo]
type Job = MVar [FileListenInfo]
type CompileM = Reader CompileInput
data ConductorData = ConductorData ListenState ([FileInfo] -> IO () )
data ListenState = ListenState {
currentFiles :: CurrentFiles
,mvModifiedFiles :: MvModifiedFiles
,threadIds :: [ThreadId]
}
data Duration =
OneShot
| Continuous
deriving (Show,Eq)
data Action =
Action ShakerAction
| ActionWithArg ShakerAction [String]
deriving (Show,Eq,Ord)
type InputCommand = MVar (Maybe Command)
data InputState = InputState {
shakerInputStateCommand :: InputCommand,
shakerInputStateToken :: Token
}
data ShakerAction =
Compile
| FullCompile
| TestFramework
| ModuleTestFramework
| IntelligentTestFramework
| IntelligentModuleTestFramework
| InvalidAction
| Help
| Execute
| Empty
| Quit
| Clean
deriving (Show,Eq,Ord)
data Command = Command Duration [Action]
deriving (Show,Eq)
data Verbosity =
Silent
| Debug
data ShakerInput = ShakerInput {
shakerCompileInputs :: [CompileInput]
,shakerListenerInput :: ListenerInput
,shakerPluginMap :: PluginMap
,shakerCommandMap :: CommandMap
,shakerArgument :: [String]
,shakerModifiedInfoFiles :: [FileInfo]
,shakerThreadData :: ThreadData
,shakerInputState :: InputState
,shakerLocalBuildInfo :: LocalBuildInfo
,shakerPackageIndex :: PackageIndex
,shakerModuleData :: [ModuleData]
,shakerVerbosity :: Verbosity
}
data ThreadData = ThreadData {
threadDataListenToken :: Token
,threadDataQuitToken :: Token
,threadDataListenList :: ThreadIdList
,threadDataQuitList :: ThreadIdList
}
getListenThreadList :: ShakerInput -> ThreadIdList
getListenThreadList = threadDataListenList . shakerThreadData
data CompileInput = CompileInput{
compileInputSourceDirs :: [String]
,compileInputBuildDirectory :: String
,compileInputDynFlags :: DynFlags->DynFlags
,compileInputCommandLineFlags :: [String]
,compileInputTargetFiles :: [String]
}
instance Monoid CompileInput where
mempty = CompileInput {
compileInputSourceDirs = ["."]
,compileInputBuildDirectory = "dist/shakerTarget"
,compileInputDynFlags = defaultCompileFlags
,compileInputCommandLineFlags = ["-Wall"]
,compileInputTargetFiles = []
}
mappend cpIn1 cpIn2 = CompileInput {
compileInputSourceDirs = nub $ compileInputSourceDirs cpIn1 `mappend` compileInputSourceDirs cpIn2
,compileInputBuildDirectory = compileInputBuildDirectory cpIn1
,compileInputDynFlags = compileInputDynFlags cpIn1 . compileInputDynFlags cpIn2
,compileInputCommandLineFlags = nub $ compileInputCommandLineFlags cpIn1 `mappend` compileInputCommandLineFlags cpIn2
,compileInputTargetFiles = nub $ compileInputTargetFiles cpIn1 `mappend` compileInputTargetFiles cpIn2
}
instance Show CompileInput
where show (CompileInput src _ _ commandLine target) =
concat ["CompileInput |source : ",show src," |cmdLine : ",show commandLine," |targetfiles : ", show target]
data ListenerInput = ListenerInput {
listenerInputFiles :: [FileListenInfo]
,listenerInputDelay :: Int
}
instance Monoid ListenerInput where
mempty = ListenerInput {
listenerInputFiles = mempty
,listenerInputDelay = 1000000
}
mappend l1 l2 = ListenerInput {
listenerInputFiles = listenerInputFiles l1 `mappend` listenerInputFiles l2
,listenerInputDelay = listenerInputDelay l1
}
data FileListenInfo = FileListenInfo{
fileListenInfoDir :: FilePath
,fileListenInfoIgnore :: [String]
,fileListenInfoInclude :: [String]
}
deriving (Show,Eq)
instance Monoid FileListenInfo where
mempty = FileListenInfo "." defaultExclude defaultHaskellPatterns
mappend f1 f2 = FileListenInfo {
fileListenInfoDir = fileListenInfoDir f1
,fileListenInfoIgnore = nub $ fileListenInfoIgnore f1 `mappend` fileListenInfoIgnore f2
,fileListenInfoInclude = nub $ fileListenInfoInclude f1 `mappend` fileListenInfoInclude f2
}
data FileInfo = FileInfo {
fileInfoFilePath :: FilePath
,fileInfoClockTime:: ClockTime
}
deriving (Show,Eq)
data PackageData = PackageData {
packageDataMapImportToModules :: MapImportToModules
,packageDataListProjectModules :: [String]
}
data ModuleData = ModuleData {
moduleDataName :: String
,moduleDataFileName :: String
,moduleDataHasMain :: Bool
,moduleDataProperties :: [String]
,moduleDataAssertions :: [String]
,moduleDataTestCase :: [String]
} | GhcModuleData {
ghcModuleDataName :: String
,ghcModuleDataAssertions :: [String]
,ghcModuleDataTestCase :: [String]
}
deriving (Read, Show)
instance Monoid ModuleData where
mempty = ModuleData "" "" False [] [] []
mappend fstModData@(GhcModuleData _ _ _) sndModData@(ModuleData _ _ _ _ _ _) = sndModData `mappend` fstModData
mappend fstModData@(ModuleData _ _ _ fstProps fstAsserts fstTestCases) sndModData =
fstModData {
moduleDataProperties = nub $ fstProps ++ sndProps
,moduleDataAssertions = nub $ fstAsserts ++ sndAsserts
,moduleDataTestCase = nub $ fstTestCases ++ sndTestCases
}
where (sndProps, sndAsserts, sndTestCases) = getModuleDataTests sndModData
mappend fstModData@(GhcModuleData _ fstTestCases fstAsserts) sndModData = fstModData {
ghcModuleDataTestCase = nub $ fstTestCases ++ sndTestCases
,ghcModuleDataAssertions = nub $ fstAsserts ++ sndAsserts
}
where (_, sndAsserts, sndTestCases) = getModuleDataTests sndModData
instance Eq ModuleData where
mod1 == mod2 = getModuleDataName mod1 == getModuleDataName mod2
getModuleDataTests :: ModuleData -> ([String], [String], [String])
getModuleDataTests (ModuleData _ _ _ prps asserts tests)= (prps, asserts, tests)
getModuleDataTests (GhcModuleData _ asserts tests)= ([], asserts, tests)
getModuleDataName :: ModuleData -> String
getModuleDataName (ModuleData name _ _ _ _ _) = name
getModuleDataName (GhcModuleData name _ _) = name
type MapImportToModules = M.Map String [String]
type PluginMap = M.Map ShakerAction Plugin
type CommandMap = M.Map String ShakerAction
type Plugin = Shaker IO()
defaultCompileFlags :: (DynFlags -> DynFlags)
defaultCompileFlags a = a {
verbosity = 1
,ghcLink = NoLink
}
defaultHaskellPatterns :: [String]
defaultHaskellPatterns = [".*\\.hs$", ".*\\.lhs"]
defaultExclude :: [String]
defaultExclude = [".*Setup\\.lhs$",".*Setup\\.hs$", ".*/\\."]
exitCommand :: Command
exitCommand = Command OneShot [Action Quit]
emptyCommand :: Command
emptyCommand = Command OneShot [Action Empty]
listTestLibs :: [String]
listTestLibs = ["QuickCheck","HUnit","test-framework-hunit","test-framework","test-framework-quickcheck2","shaker-test-provider"]
moduleDataExtension :: String
moduleDataExtension = ".mdata"
defaultDistDir :: String
defaultDistDir = "dist/shakerTarget"