Create a gist now

Instantly share code, notes, and snippets.

What would you like to do?
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

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