Automata

Automata.hs

{- requires -XArrows -}
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

Wow, arrows.

Yeah -- still trying to make sense of it all. Seems more intuitive than monads though.