petermarks · November 6, 2011 18:20 · Nov 6, 2011 · Nov 6, 2011
diff --git a/Automata.hs b/Automata.hs
@@ -1,8 +1,11 @@
+
 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))
 
@@ -44,3 +47,46 @@ instance Arrow Automaton where
   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
diff --git a/Automata.hs b/Automata.hs
@@ -0,0 +1,46 @@
+module Automata where
+
+import Prelude hiding (id, (.))
+import Control.Category
+import Control.Arrow
+
+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' )