module MergeBashHistory ( Timestamp , Command , HmbhError , HistoryRecord , mergeRecords , parseFile , recordToText ) where import Control.Applicative ((<|>)) import Data.EitherR (fmapL) import Data.List.Ordered (merge, nub) import Data.Text (Text) import qualified Data.Text as Text import Data.Attoparsec.Text type Timestamp = Integer type Command = Text data HistoryLine = Header Timestamp | Command Command deriving (Show) data HmbhError = ParseError String | EmptyFile | MissingHeader instance Show HmbhError where show (ParseError e) = "Error: Parser Error '" ++ e ++ "'" show EmptyFile = "Error: Merging with empty file" show MissingHeader = "Error: Missing header" data HistoryRecord = HistoryRecord { header :: Timestamp , commands :: [Command] } deriving (Eq, Show) instance Ord HistoryRecord where h1 `compare` h2 = header h1 `compare` header h2 recordToText :: HistoryRecord -> Text recordToText (HistoryRecord t c) = Text.unlines $ Text.pack ('#' : show t) : c emptyRecord :: Timestamp -> HistoryRecord emptyRecord t = HistoryRecord { header = t, commands = [] } appendCommand :: HistoryRecord -> Command -> HistoryRecord appendCommand hr c = hr { commands = commands hr ++ [c] } linesToRecords :: [HistoryLine] -> Either HmbhError [HistoryRecord] linesToRecords [] = Left EmptyFile linesToRecords (Command _: _) = Left MissingHeader linesToRecords (Header t: as) = Right $ squash $ foldr f (emptyRecord t, []) as where f (Header s) acc = (emptyRecord s, squash acc) f (Command c) (current, ps) = (appendCommand current c, ps) squash (x, xs) = x : xs historyHeader :: Parser HistoryLine historyHeader = do _ <- char '#' t <- decimal endOfLine return $ Header t historyCommand :: Parser HistoryLine historyCommand = do c <- takeTill isEndOfLine endOfLine return $ Command c historyLine :: Parser HistoryLine historyLine = historyHeader <|> historyCommand historyLines :: Parser [HistoryLine] historyLines = many' historyLine mergeRecords :: [HistoryRecord] -> [HistoryRecord] -> [HistoryRecord] mergeRecords a b = nub $ merge a b parseFile :: Text -> Either HmbhError [HistoryRecord] parseFile t = fmapL ParseError (parseOnly historyLines t) >>= linesToRecords