Skip to content

Instantly share code, notes, and snippets.

@petermarks
Created November 6, 2011 18:20
Show Gist options
  • Save petermarks/1343275 to your computer and use it in GitHub Desktop.
Save petermarks/1343275 to your computer and use it in GitHub Desktop.
Automata
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
@mmakowski
Copy link

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

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment