hpastetwo

.

author
0xd34df00d
age
280 days
language
haskell
 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
import List                                                                                                                                                                                                                                  
import Data.List                                                                                                                                                                                                                             
import Numeric                                                                                                                                                                                                                               
import Control.Concurrent                                                                                                                                                                                                                    
import System.IO                                                                                                                                                                                                                             
import System.Environment                                                                                                                                                                                                                    
import System.Posix.Process                                                                                                                                                                                                                  
                                                                                                                                                                                                                                             
data ParsedEntity = ParsedEntity {                                                                                                                                                                                                           
    delay   :: Int,                                                                                                                                                                                                                          
    binary  :: String,                                                                                                                                                                                                                       
    args    :: [String]                                                                                                                                                                                                                      
} deriving (Show, Eq)                                                                                                                                                                                                                        
                                                                                                                                                                                                                                             
instance Ord ParsedEntity where                                                                                                                                                                                                              
    compare x y                                                                                                                                                                                                                              
        | delay x == delay y    = EQ                                                                                                                                                                                                         
        | delay x < delay y     = LT                                                                                                                                                                                                         
        | otherwise             = GT                                                                                                                                                                                                         
                                                                                                                                                                                                                                             
main =                                                                                                                                                                                                                                       
    getArgs >>= handleArgs                                                                                                                                                                                                                   
    where handleArgs (name:_) = do                                                                                                                                                                                                           
            inh <- openFile name ReadMode                                                                                                                                                                                                    
            contents <- hGetContents inh                                                                                                                                                                                                     
            let entities = parseContents contents                                                                                                                                                                                            
            print entities                                                                                                                                                                                                                   
            processEntities entities                                                                                                                                                                                                         
            hClose inh                                                                                                                                                                                                                       
          handleArgs _ = putStrLn "Incorrect args format"                                                                                                                                                                                    
                                                                                                                                                                                                                                             
processEntities = mapM processEntity                                                                                                                                                                                                         
    where processEntity e = do                                                                                                                                                                                                               
            threadDelay $ 1000000 * delay e                                                                                                                                                                                                  
            putStrLn $ "Running " ++ binary e ++ " with arguments " ++ show (args e)                                                                                                                                                         
            forkProcess $ executeFile (binary e) False (args e) Nothing                                                                                                                                                                      
                                                                                                                                                                                                                                             
parseContents = snd . sequenize . buildSorted                                                                                                                                                                                                
    where sequenize = foldl' f (0, [])                                                                                                                                                                                                       
            where f (acc, xs) e = (delay e, xs ++ [(ParsedEntity (delay e - acc) (binary e) (args e))])                                                                                                                                      
          buildSorted = sort . map parseLine . lines                                                                                                                                                                                         
            where parseLine line = ParsedEntity (fst rd) (head (words (snd rd))) (tail (words (snd rd)))                                                                                                                                     
                    where rd = head $ readDec line