Bash command history parser

Parser.hs

module Parser where

import Data.Generics
import Data.List.Split (splitOn)
import Control.Applicative ((<$>), (<*>))
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
import Data.Time hiding (parseTime)

-- A customised version of language-sh is needed
import qualified Language.Sh.Parser as P
import qualified Language.Sh.Syntax as P
import qualified Language.Sh.Pretty as P


data CommandEntry = CommandEntry {
      time :: LocalTime
    , cmd  :: String
} deriving (Show)


parseTime :: String -> LocalTime
parseTime str = unixToLocal $ realToFrac $ read str
  where
    unixToLocal = utcToLocalTime (hoursToTimeZone 8) . posixSecondsToUTCTime


parseCommand :: String -> Maybe [String]
parseCommand str =
    case P.parse [] str of
      Left  _ -> Nothing
      Right r -> notEmpty $ removeSpecial $ collectCommand r
  where

    removeSpecial = filter (`notElem` ["[", "[["])

    notEmpty [] = Nothing
    notEmpty x  = Just x

    collectCommand = everything (++) ([] `mkQ` getCommand)

    getCommand :: P.Statement -> [String]
    getCommand (P.Statement (x:_) _ _) = [P.pretty x]
    getCommand _ = []


parse :: String -> [CommandEntry]
parse str = concatMap parseEntry $ tail $ splitOn "#" str
  where
    parseEntry str =
        let (tstr, cmdstr') = break (=='\n') str
            cmdstr = drop 1 cmdstr'
            time = parseTime tstr
            cmds = parseCommand cmdstr
        in case cmds of
             Nothing -> []
             Just cs -> map (CommandEntry time) cs

Query.hs

module Query where

import Parser
import Data.List
import Data.Ord
import Data.Time
import Data.Time.Calendar.WeekDate

sortByCount = sortGroupSort cmd (\ces -> (cmd $ head ces, length ces)) snd

groupByWeekDate =
    sortGroupSort weekDate (\ces -> (weekDate $ head ces, length ces)) id
  where
    weekDate c = case toWeekDate $ localDay $ time c of (_, _, w) -> w

groupByHour =
    sortGroupSort hour (\ces -> (hour $ head ces, length ces)) id
  where
    hour c = todHour $ localTimeOfDay $ time c

sortGroupSort groupCmp f sortCmp =
    sortBy (comparing sortCmp)
    . map f
    . groupBy (\ce1 ce2 -> groupCmp ce1 == groupCmp ce2)
    . sortBy (comparing groupCmp)