1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
------------------------------------------------------------------------
--- Implementation of a worker client to analyze a module
---
--- @author Heiko Hoffmann, Michael Hanus
--- @version April 2021
------------------------------------------------------------------------

module CASS.Worker ( startWorker ) where

import System.IO            ( Handle, hClose, hFlush, hWaitForInput
                            , hPutStrLn, hGetLine )
import System.Environment   ( getArgs, setEnv )

import Analysis.Logging     ( debugMessage )
import Network.Socket       ( connectToSocket )

import CASS.Configuration   ( CConfig, debugLevel, waitTime, getDefaultPath )
import CASS.Registry        ( lookupRegAnaWorker )
import CASS.ServerFunctions ( WorkerMessage(..) )

startWorker :: CConfig -> String -> Int -> IO ()
startWorker cconfig host port = do
  debugMessage dl 2 ("start analysis worker on port " ++ show port)
  getDefaultPath cconfig >>= setEnv "CURRYPATH"
  handle <- connectToSocket host port
  worker cconfig handle
 where dl = debugLevel cconfig

-- communication loop
worker :: CConfig -> Handle -> IO ()
worker cconfig handle = do
  gotInput <- hWaitForInput handle waitTime
  if gotInput
    then do
       input <- hGetLine handle
       debugMessage dl 3 ("input: "++input)
       case read input of
         Task ananame moduleName -> do
           debugMessage dl 1 ("Start task: "++ananame++" for "++moduleName)
           -- Run the analysis worker for the given analysis and module:
           (lookupRegAnaWorker ananame) cconfig [moduleName]
           debugMessage dl 1 ("Finished task: "++ananame++" for "++moduleName)
           debugMessage dl 3 ("Output: "++input)
           hPutStrLn handle input
           hFlush handle
           worker cconfig handle
         ChangePath path -> do
           setEnv "CURRYPATH" path
           worker cconfig handle
         StopWorker -> do
           debugMessage dl 2 "Stop worker"
           hClose handle
           return ()
    else return ()
 where dl = debugLevel cconfig