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