{-# 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 (Int -> InputHistory -> ShowS) -> (InputHistory -> String) -> ([InputHistory] -> ShowS) -> Show InputHistory 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 HashMap ChannelId (Vector Text) forall a. Monoid a => a mempty removeChannelHistory :: ChannelId -> InputHistory -> InputHistory removeChannelHistory :: ChannelId -> InputHistory -> InputHistory removeChannelHistory ChannelId cId InputHistory ih = InputHistory ih InputHistory -> (InputHistory -> InputHistory) -> InputHistory forall a b. a -> (a -> b) -> b & (HashMap ChannelId (Vector Text) -> Identity (HashMap ChannelId (Vector Text))) -> InputHistory -> Identity InputHistory Lens' InputHistory (HashMap ChannelId (Vector Text)) historyEntries((HashMap ChannelId (Vector Text) -> Identity (HashMap ChannelId (Vector Text))) -> InputHistory -> Identity InputHistory) -> ((Maybe (Vector Text) -> Identity (Maybe (Vector Text))) -> HashMap ChannelId (Vector Text) -> Identity (HashMap ChannelId (Vector Text))) -> (Maybe (Vector Text) -> Identity (Maybe (Vector Text))) -> InputHistory -> Identity InputHistory forall b c a. (b -> c) -> (a -> b) -> a -> c .Index (HashMap ChannelId (Vector Text)) -> Lens' (HashMap ChannelId (Vector Text)) (Maybe (IxValue (HashMap ChannelId (Vector Text)))) forall m. At m => Index m -> Lens' m (Maybe (IxValue m)) at ChannelId Index (HashMap ChannelId (Vector Text)) cId ((Maybe (Vector Text) -> Identity (Maybe (Vector Text))) -> InputHistory -> Identity InputHistory) -> Maybe (Vector Text) -> InputHistory -> InputHistory forall s t a b. ASetter s t a b -> b -> s -> t .~ Maybe (Vector Text) 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 (String -> IO ()) -> String -> IO () forall a b. (a -> b) -> a -> b $ ShowS dropFileName String historyFile let entries :: [(ChannelId, [Text])] entries = (\(ChannelId cId, Vector Text z) -> (ChannelId cId, Vector Text -> [Text] forall a. Vector a -> [a] V.toList Vector Text z)) ((ChannelId, Vector Text) -> (ChannelId, [Text])) -> [(ChannelId, Vector Text)] -> [(ChannelId, [Text])] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> (HashMap ChannelId (Vector Text) -> [(ChannelId, Vector Text)] forall k v. HashMap k v -> [(k, v)] HM.toList (HashMap ChannelId (Vector Text) -> [(ChannelId, Vector Text)]) -> HashMap ChannelId (Vector Text) -> [(ChannelId, Vector Text)] forall a b. (a -> b) -> a -> b $ InputHistory ihInputHistory -> Getting (HashMap ChannelId (Vector Text)) InputHistory (HashMap ChannelId (Vector Text)) -> HashMap ChannelId (Vector Text) forall s a. s -> Getting a s a -> a ^.Getting (HashMap ChannelId (Vector Text)) InputHistory (HashMap ChannelId (Vector Text)) Lens' InputHistory (HashMap ChannelId (Vector Text)) historyEntries) String -> String -> IO () writeFile String historyFile (String -> IO ()) -> String -> IO () forall a b. (a -> b) -> a -> b $ [(ChannelId, [Text])] -> String 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 = ExceptT String IO InputHistory -> IO (Either String InputHistory) forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a) runExceptT (ExceptT String IO InputHistory -> IO (Either String InputHistory)) -> ExceptT String IO InputHistory -> IO (Either String InputHistory) forall a b. (a -> b) -> a -> b $ do String contents <- IO String -> ExceptT String IO String forall a. IO a -> ExceptT String IO a convertIOException (String -> IO String S.readFile (String -> IO String) -> IO String -> IO String forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b =<< IO String historyFilePath) case ReadS [(ChannelId, [Text])] 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, [Text] -> Vector Text forall a. [a] -> Vector a V.fromList [Text] es)) ((ChannelId, [Text]) -> (ChannelId, Vector Text)) -> [(ChannelId, [Text])] -> [(ChannelId, Vector Text)] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> [(ChannelId, [Text])] val InputHistory -> ExceptT String IO InputHistory forall (m :: * -> *) a. Monad m => a -> m a return (InputHistory -> ExceptT String IO InputHistory) -> InputHistory -> ExceptT String IO InputHistory forall a b. (a -> b) -> a -> b $ HashMap ChannelId (Vector Text) -> InputHistory InputHistory (HashMap ChannelId (Vector Text) -> InputHistory) -> HashMap ChannelId (Vector Text) -> InputHistory forall a b. (a -> b) -> a -> b $ [(ChannelId, Vector Text)] -> HashMap ChannelId (Vector Text) forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v HM.fromList [(ChannelId, Vector Text)] entries [([(ChannelId, [Text])], String)] _ -> String -> ExceptT String IO InputHistory 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 InputHistory -> (InputHistory -> InputHistory) -> InputHistory forall a b. a -> (a -> b) -> b & (HashMap ChannelId (Vector Text) -> Identity (HashMap ChannelId (Vector Text))) -> InputHistory -> Identity InputHistory Lens' InputHistory (HashMap ChannelId (Vector Text)) historyEntries((HashMap ChannelId (Vector Text) -> Identity (HashMap ChannelId (Vector Text))) -> InputHistory -> Identity InputHistory) -> ((Maybe (Vector Text) -> Identity (Maybe (Vector Text))) -> HashMap ChannelId (Vector Text) -> Identity (HashMap ChannelId (Vector Text))) -> (Maybe (Vector Text) -> Identity (Maybe (Vector Text))) -> InputHistory -> Identity InputHistory forall b c a. (b -> c) -> (a -> b) -> a -> c .Index (HashMap ChannelId (Vector Text)) -> Lens' (HashMap ChannelId (Vector Text)) (Maybe (IxValue (HashMap ChannelId (Vector Text)))) forall m. At m => Index m -> Lens' m (Maybe (IxValue m)) at ChannelId Index (HashMap ChannelId (Vector Text)) cId ((Maybe (Vector Text) -> Identity (Maybe (Vector Text))) -> InputHistory -> Identity InputHistory) -> (Maybe (Vector Text) -> Maybe (Vector Text)) -> InputHistory -> InputHistory 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 = Vector Text -> Maybe (Vector Text) forall a. a -> Maybe a Just (Vector Text -> Maybe (Vector Text)) -> Vector Text -> Maybe (Vector Text) forall a b. (a -> b) -> a -> b $ Text -> Vector Text forall a. a -> Vector a V.singleton Text e insertEntry (Just Vector Text v) = Vector Text -> Maybe (Vector Text) forall a. a -> Maybe a Just (Vector Text -> Maybe (Vector Text)) -> Vector Text -> Maybe (Vector Text) forall a b. (a -> b) -> a -> b $ Text -> Vector Text -> Vector Text forall a. a -> Vector a -> Vector a V.cons Text e ((Text -> Bool) -> Vector Text -> Vector Text forall a. (a -> Bool) -> Vector a -> Vector a V.filter (Text -> Text -> Bool 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 ihInputHistory -> Getting (Maybe (Vector Text)) InputHistory (Maybe (Vector Text)) -> Maybe (Vector Text) forall s a. s -> Getting a s a -> a ^.(HashMap ChannelId (Vector Text) -> Const (Maybe (Vector Text)) (HashMap ChannelId (Vector Text))) -> InputHistory -> Const (Maybe (Vector Text)) InputHistory Lens' InputHistory (HashMap ChannelId (Vector Text)) historyEntries((HashMap ChannelId (Vector Text) -> Const (Maybe (Vector Text)) (HashMap ChannelId (Vector Text))) -> InputHistory -> Const (Maybe (Vector Text)) InputHistory) -> ((Maybe (Vector Text) -> Const (Maybe (Vector Text)) (Maybe (Vector Text))) -> HashMap ChannelId (Vector Text) -> Const (Maybe (Vector Text)) (HashMap ChannelId (Vector Text))) -> Getting (Maybe (Vector Text)) InputHistory (Maybe (Vector Text)) forall b c a. (b -> c) -> (a -> b) -> a -> c .Index (HashMap ChannelId (Vector Text)) -> Lens' (HashMap ChannelId (Vector Text)) (Maybe (IxValue (HashMap ChannelId (Vector Text)))) forall m. At m => Index m -> Lens' m (Maybe (IxValue m)) at ChannelId Index (HashMap ChannelId (Vector Text)) cId Vector Text es Vector Text -> Getting (First Text) (Vector Text) Text -> Maybe Text forall s a. s -> Getting (First a) s a -> Maybe a ^? Index (Vector Text) -> Traversal' (Vector Text) (IxValue (Vector Text)) forall m. Ixed m => Index m -> Traversal' m (IxValue m) ix Int Index (Vector Text) i