public
Created

Automata

  • Download Gist
Automata.hs
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 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92
 
module Automata where
 
import Prelude hiding (id, (.))
import Control.Category
import Control.Arrow
import qualified Data.Map as M
import Data.List (sort)
 
data Automaton b c = Automaton (b -> (c, Automaton b c))
 
runA :: [a] -> Automaton a b -> [b]
runA (x:xs) (Automaton f) = let (output, a) = f x in
output : runA xs a
runA [] _ = []
 
runningSum :: Automaton Int Int
-- runningSum = Automaton $ f 0
-- where f s x = ( s+x , Automaton $ f ( s+x ) )
runningSum = acc (+) 0
acc :: (a -> b -> b) -> b -> Automaton a b
acc op seed = Automaton $ f seed
where f s x = let n = op x s in
( n , Automaton $ f n )
 
delay :: a -> Automaton a a
delay seed = Automaton $ \x -> (seed, delay x)
 
delayn :: Int -> a -> Automaton a a
delayn 0 seed = id
delayn n seed = delay seed >>> delayn (n-1) seed
 
delayList :: [a] -> Automaton a a
delayList [] = id
delayList (s:ss) = delayList ss >>> delay s
 
instance Category Automaton where
id = arr id
(Automaton g) . (Automaton f) = Automaton h
where h x = let (output, f') = f x
(output', g') = g output in
(output', g' . f')
 
instance Arrow Automaton where
arr f = Automaton $ \a -> (f a, arr f)
first (Automaton f) = Automaton h
where h (x, y) = let (output, f') = f x in
((output, y), first f' )
 
 
-- interact processFile
 
processFile :: IO ()
processFile = do
f <- readFile "/var/log/syslog"
let ls = lines f
let os = runA ls processString
print $ (last os)
 
data Entry = Entry {
date :: String,
host :: String,
program :: String,
message :: String
} deriving Show
parse :: String -> Entry
parse s = Entry d h p m
where d1:d2:d3:h:p':ms = words s
d = unwords [d1,d2,d3]
p = init p'
m = unwords ms
--processString = (arr parse >>> summary >>> arr top10) &&& countLines
processString = proc x -> do
top <- arr parse >>> summary >>> arr top10 -< x
count <- countLines -< x
returnA (top, count)
 
summary :: Automaton Entry (M.Map String Int)
summary = acc op M.empty
where op :: Entry -> M.Map String Int -> M.Map String Int
op e = M.insertWith' (+) (program e) 1
top10 :: (M.Map String Int) -> [(Int, String)]
top10 = take 10 . reverse . sort . map swap . M.toList
 
swap (x,y) = (y, x)
 
countLines = acc (const (+ 1)) 0

line 79 should be returnA -< (top, count), no?

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.