{-# LANGUAGE TemplateHaskell #-} module Matterhorn.InputHistory ( InputHistory , newHistory , readHistory , writeHistory , addHistoryEntry , getHistoryEntry , removeChannelHistory ) where import Prelude () import Matterhorn.Prelude import Control.Monad.Trans.Except import qualified Data.HashMap.Strict as HM import qualified Data.Vector as V import Lens.Micro.Platform ( (.~), (%~), at, ix, makeLenses ) import System.Directory ( createDirectoryIfMissing ) import System.FilePath ( dropFileName ) import qualified System.IO.Strict as S import qualified System.Posix.Files as P import qualified System.Posix.Types as P import Network.Mattermost.Types ( ChannelId ) import Matterhorn.FilePaths import Matterhorn.IOUtil data InputHistory = InputHistory { InputHistory -> HashMap ChannelId (Vector Text) _historyEntries :: HashMap ChannelId (V.Vector Text) } deriving (Int -> InputHistory -> ShowS [InputHistory] -> ShowS InputHistory -> String forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [InputHistory] -> ShowS $cshowList :: [InputHistory] -> ShowS show :: InputHistory -> String $cshow :: InputHistory -> String showsPrec :: Int -> InputHistory -> ShowS $cshowsPrec :: Int -> InputHistory -> ShowS Show) makeLenses ''InputHistory newHistory :: InputHistory newHistory :: InputHistory newHistory = HashMap ChannelId (Vector Text) -> InputHistory InputHistory forall a. Monoid a => a mempty removeChannelHistory :: ChannelId -> InputHistory -> InputHistory removeChannelHistory :: ChannelId -> InputHistory -> InputHistory removeChannelHistory ChannelId cId InputHistory ih = InputHistory ih forall a b. a -> (a -> b) -> b & Lens' InputHistory (HashMap ChannelId (Vector Text)) historyEntriesforall b c a. (b -> c) -> (a -> b) -> a -> c .forall m. At m => Index m -> Lens' m (Maybe (IxValue m)) at ChannelId cId forall s t a b. ASetter s t a b -> b -> s -> t .~ forall a. Maybe a Nothing historyFileMode :: P.FileMode historyFileMode :: FileMode historyFileMode = FileMode -> FileMode -> FileMode P.unionFileModes FileMode P.ownerReadMode FileMode P.ownerWriteMode writeHistory :: InputHistory -> IO () writeHistory :: InputHistory -> IO () writeHistory InputHistory ih = do String historyFile <- IO String historyFilePath Bool -> String -> IO () createDirectoryIfMissing Bool True forall a b. (a -> b) -> a -> b $ ShowS dropFileName String historyFile let entries :: [(ChannelId, [Text])] entries = (\(ChannelId cId, Vector Text z) -> (ChannelId cId, forall a. Vector a -> [a] V.toList Vector Text z)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> (forall k v. HashMap k v -> [(k, v)] HM.toList forall a b. (a -> b) -> a -> b $ InputHistory ihforall s a. s -> Getting a s a -> a ^.Lens' InputHistory (HashMap ChannelId (Vector Text)) historyEntries) String -> String -> IO () writeFile String historyFile forall a b. (a -> b) -> a -> b $ forall a. Show a => a -> String show [(ChannelId, [Text])] entries String -> FileMode -> IO () P.setFileMode String historyFile FileMode historyFileMode readHistory :: IO (Either String InputHistory) readHistory :: IO (Either String InputHistory) readHistory = forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a) runExceptT forall a b. (a -> b) -> a -> b $ do String contents <- forall a. IO a -> ExceptT String IO a convertIOException (String -> IO String S.readFile forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b =<< IO String historyFilePath) case forall a. Read a => ReadS a reads String contents of [([(ChannelId, [Text])] val, String "")] -> do let entries :: [(ChannelId, Vector Text)] entries = (\(ChannelId cId, [Text] es) -> (ChannelId cId, forall a. [a] -> Vector a V.fromList [Text] es)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> [(ChannelId, [Text])] val forall (m :: * -> *) a. Monad m => a -> m a return forall a b. (a -> b) -> a -> b $ HashMap ChannelId (Vector Text) -> InputHistory InputHistory forall a b. (a -> b) -> a -> b $ forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v HM.fromList [(ChannelId, Vector Text)] entries [([(ChannelId, [Text])], String)] _ -> forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a throwE String "Failed to parse history file" addHistoryEntry :: Text -> ChannelId -> InputHistory -> InputHistory addHistoryEntry :: Text -> ChannelId -> InputHistory -> InputHistory addHistoryEntry Text e ChannelId cId InputHistory ih = InputHistory ih forall a b. a -> (a -> b) -> b & Lens' InputHistory (HashMap ChannelId (Vector Text)) historyEntriesforall b c a. (b -> c) -> (a -> b) -> a -> c .forall m. At m => Index m -> Lens' m (Maybe (IxValue m)) at ChannelId cId forall s t a b. ASetter s t a b -> (a -> b) -> s -> t %~ Maybe (Vector Text) -> Maybe (Vector Text) insertEntry where insertEntry :: Maybe (Vector Text) -> Maybe (Vector Text) insertEntry Maybe (Vector Text) Nothing = forall a. a -> Maybe a Just forall a b. (a -> b) -> a -> b $ forall a. a -> Vector a V.singleton Text e insertEntry (Just Vector Text v) = forall a. a -> Maybe a Just forall a b. (a -> b) -> a -> b $ forall a. a -> Vector a -> Vector a V.cons Text e (forall a. (a -> Bool) -> Vector a -> Vector a V.filter (forall a. Eq a => a -> a -> Bool /= Text e) Vector Text v) getHistoryEntry :: ChannelId -> Int -> InputHistory -> Maybe Text getHistoryEntry :: ChannelId -> Int -> InputHistory -> Maybe Text getHistoryEntry ChannelId cId Int i InputHistory ih = do Vector Text es <- InputHistory ihforall s a. s -> Getting a s a -> a ^.Lens' InputHistory (HashMap ChannelId (Vector Text)) historyEntriesforall b c a. (b -> c) -> (a -> b) -> a -> c .forall m. At m => Index m -> Lens' m (Maybe (IxValue m)) at ChannelId cId Vector Text es forall s a. s -> Getting (First a) s a -> Maybe a ^? forall m. Ixed m => Index m -> Traversal' m (IxValue m) ix Int i