Vim log lexer, originally from http://www.drbunsen.org/vim-croquet/

VimLexer.hs

import qualified Data.ByteString.Lazy.Char8 as LC
import qualified Data.List as DL
import qualified Data.List.Split as LS
import System.IO

-- | Reformat the Vim key log from stdin to stdout.
main :: IO ()
main = hSetEncoding stdout utf8 >>
       LC.getContents >>= mapM_ putStrLn . process

-- | Process all of the words.
process :: LC.ByteString -> [String]
process =   affixStrip
          . startsWith
          . splitOnMode
          . modeSub
          . capStrings
          . split mark
          . preprocess

-- | Build a function of String -> String by chaining
-- together all of the given input substitutions.
subs :: [(String, String)] -> String -> String
subs = foldr (\pair acc -> sub pair . acc) id

-- | Replace all instances of s in lst with r.
sub :: (String, String) -> String -> String
sub (s,r) lst@(x:xs)
    | s `DL.isPrefixOf` lst = sub'
    | otherwise = x:sub (s,r) xs
    where
        sub' = r ++ sub (s,r) (drop (length s) lst)
sub (_,_) [] = []

-- | Convert input ByteString to a String, normalize the whitespace, and
-- replace all meta characters.
preprocess :: LC.ByteString -> String
preprocess =   subs meta
             . DL.unwords
             . DL.words
             . LC.unpack

splitOnMode :: [String] -> [String]
splitOnMode = concatMap (\el -> split mode el)

-- | Keep strings that start with the "-(*)-" marker and have
-- additional content.
startsWith :: [String] -> [String]
startsWith = filter (\el -> mark `DL.isPrefixOf` el
                         && el /= mark)

-- | Do mode substitutions on the input string.
modeSub :: [String] -> [String]
modeSub = map (subs mtsl)

-- | Split on the given string.
split :: String -> String -> [String]
split = LS.split . LS.dropBlanks . LS.dropDelims . LS.onSublist

-- | Remove markers from the input strings and remove strings that begin with
-- "[M".
affixStrip :: [String] -> [String]
affixStrip =   clean
             . concatMap (split mark)

-- | Put the "-(*)-" marker around each of the input strings.
capStrings :: [String] -> [String]
capStrings = map (\el -> mark ++ el ++ mark)

-- | Filter out strings that begin with "[M".
clean :: [String] -> [String]
clean = filter (not . DL.isInfixOf "[M")

mark, mode, n :: String
(mark, mode, n) = ("-(*)-","-(!)-", "")

meta, mtsl :: [(String, String)]
meta = [("\"",n),
        ("\\",n),
        ("\195\130\194\128\195\131\194\189`",n),
        ("\194\128\195\189`",n),
        ("\194\128kb\ESC",n),
        ("\194\128kb",n),
        ("[>0;95;c",n),
        ("[>0;95;0c",n),
        ("\ESC",mark),
        ("\ETX",mark),
        ("\r",mark)]
mtsl = [(":",mode),
        ("A",mode),
        ("a",mode),
        ("I",mode),
        ("i",mode),
        ("O",mode),
        ("o",mode),
        ("v", mode),
        ("/",mode),
        ("\ENQ","⌃e"),
        ("\DLE","⌃p"),
        ("\NAK","⌃u"),
        ("\EOT","⌃d"),
        ("\ACK","⌃f"),
        ("\STX","⌃f"),
        ("\EM","⌃y"),
        ("\SI","⌃o"),
        ("\SYN","⌃v"),
        ("\DC2","⌃r")]