{-# 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