added parallel graph-parsing, enabled profiling
This commit is contained in:
		
							
								
								
									
										51
									
								
								src/Main.hs
									
									
									
									
									
								
							
							
						
						
									
										51
									
								
								src/Main.hs
									
									
									
									
									
								
							| @@ -29,13 +29,28 @@ import Control.Monad.Par.Scheds.Trace | ||||
| import qualified Data.Stream as S | ||||
| import Data.Either (lefts, rights) | ||||
|  | ||||
| import Stream | ||||
| import Stream hiding (map) | ||||
|  | ||||
|  | ||||
| -- TODO: implement parser! | ||||
| createGraph :: ByteString -> Either [Int] String | ||||
| createGraph _ = Left [1,2,3] | ||||
| createGraph :: String -> Either [Int] String | ||||
| createGraph input = createGraph' input (Left []) | ||||
|     where | ||||
|         createGraph' :: String -> Either [Int] String -> Either [Int] String | ||||
|         createGraph' [] r     = r | ||||
|         createGraph' (a:as) r = | ||||
|                     let next = (createGraph' as r) in | ||||
|                         case next of | ||||
|                             Left xs -> | ||||
|                                 case a of | ||||
|                                     '0' -> Left $ 0:xs | ||||
|                                     '1' -> Left $ 1:xs | ||||
|                                     _   -> Right $ "cannot parse " ++ (a:as) | ||||
|                             Right errstr -> | ||||
|                                 Right errstr | ||||
| --createGraph input = Right $ "Parsing-error in line: " ++ input | ||||
|  | ||||
| -- TODO: not needed anymore. remove? Later use? | ||||
| graphFolder :: [Either [Int] String] -> (Either [[Int]] String) | ||||
| graphFolder [] = Right "empty Graph" | ||||
| graphFolder l = graphFolder' l (Left [[]]) | ||||
| @@ -60,6 +75,21 @@ graphFolder l = graphFolder' l (Left [[]]) | ||||
| concatWith :: String -> String -> String -> String | ||||
| concatWith d a b = a ++ d ++ b | ||||
|  | ||||
| emptyLine :: String -> Bool | ||||
| emptyLine "" = True | ||||
| emptyLine "\n" = True | ||||
| emptyLine "\r\n" = True | ||||
| emptyLine "\r" = True | ||||
| emptyLine _ = False | ||||
|  | ||||
| emptyLog :: [String] -> Bool | ||||
| emptyLog [] = True | ||||
| emptyLog a = emptyLine $ foldl1 (++) a | ||||
|  | ||||
| -- TODO: implement calculation | ||||
| doCalculation :: [[Int]] -> ByteString | ||||
| doCalculation a = B.pack $ (show a) ++ "\n" | ||||
|  | ||||
| exeMain = do | ||||
|     args <- getArgs | ||||
|     input <- case args of | ||||
| @@ -67,14 +97,17 @@ exeMain = do | ||||
|             [] -> error "Error: No filename or stdinput (-) given." | ||||
|             [file] -> B.readFile file | ||||
|     -- unrefined_graph::[Either [Int] String] - [Int] is Adjacency-Line, String is parse-Error | ||||
|     unrefined_graph <- return $ parMap (rparWith rdeepseq) (createGraph) (B.split '\n' input) | ||||
|     unrefined_graph <- return $ parMap (rparWith rdeepseq) --run parallel, evaluate fully | ||||
|                                                         -- and filter empty lines | ||||
|                                         (createGraph) (filter (not . emptyLine) | ||||
|                                                         -- split at \n, convert to String | ||||
|                                                         (map B.unpack (B.split '\n' input))) | ||||
|     --egraph <- return $ graphFolder unrefined_graph | ||||
|     (graph, log) <- return (lefts unrefined_graph, rights unrefined_graph) | ||||
|  | ||||
|     --do stuff with graph | ||||
|  | ||||
|     B.putStr $ B.pack (foldl (concatWith "\n") "" log) -- Print output | ||||
|  | ||||
|     output <- return $ case emptyLog log of | ||||
|         True -> doCalculation graph | ||||
|         _    -> B.pack $ "Error detected:\n" ++ (foldl (concatWith "\n") "" log) ++ "\n\n" | ||||
|     B.putStr output | ||||
|  | ||||
|  | ||||
| -- Entry point for unit tests. | ||||
|   | ||||
		Reference in New Issue
	
	Block a user