{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
module Proof.Assistant.RefreshFile where

import Data.ByteString (ByteString)
import Data.Coerce (coerce)
import System.Directory
import System.FilePath
import Telegram.Bot.API (ChatId (..))

import Proof.Assistant.Helpers
import Proof.Assistant.Request
import Proof.Assistant.Settings

import qualified Data.ByteString.Char8 as BS8
import qualified Data.Text as Text

-- | Most interpreters work with files. Therefore, we need to store user input as a file.
-- Remember that input could come from different chats, so we need to store input separately.
-- Unless directory specified, temporary directory will be used to store the files.
refreshTmpFile
  :: ExternalInterpreterSettings
  -> InterpreterRequest
  -> Maybe FilePath
  -> IO (FilePath, FilePath)
refreshTmpFile :: ExternalInterpreterSettings
-> InterpreterRequest -> Maybe FilePath -> IO (FilePath, FilePath)
refreshTmpFile
  ExternalInterpreterSettings
settings
  ir :: InterpreterRequest
ir@InterpreterRequest{ByteString
interpreterRequestMessage :: InterpreterRequest -> ByteString
interpreterRequestMessage :: ByteString
interpreterRequestMessage} Maybe FilePath
mDir = do
    FilePath
tmpDir <- IO FilePath
-> (FilePath -> IO FilePath) -> Maybe FilePath -> IO FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO FilePath
getTemporaryDirectory FilePath -> IO FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe FilePath
mDir
    let tmpFilepath :: FilePath
tmpFilepath = ExternalInterpreterSettings
-> InterpreterRequest -> FilePath -> FilePath
getTempFilePath ExternalInterpreterSettings
settings InterpreterRequest
ir FilePath
tmpDir
        createFile :: IO (FilePath, FilePath)
createFile = do
          FilePath -> ByteString -> IO ()
BS8.writeFile FilePath
tmpFilepath (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
dropSubCommand ByteString
interpreterRequestMessage
          (FilePath, FilePath) -> IO (FilePath, FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath
tmpDir, FilePath
tmpFilepath)
    Bool
exist <- FilePath -> IO Bool
doesFileExist FilePath
tmpFilepath
    if (Bool -> Bool
not Bool
exist)
      then IO (FilePath, FilePath)
createFile
      else FilePath -> IO ()
removeFile FilePath
tmpFilepath IO () -> IO (FilePath, FilePath) -> IO (FilePath, FilePath)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO (FilePath, FilePath)
createFile

-- | Make absolute filepath based on settings, request and directory.
getTempFilePath :: ExternalInterpreterSettings -> InterpreterRequest -> FilePath -> FilePath
getTempFilePath :: ExternalInterpreterSettings
-> InterpreterRequest -> FilePath -> FilePath
getTempFilePath
  ExternalInterpreterSettings{FilePath
$sel:tempFilePrefix:ExternalInterpreterSettings :: ExternalInterpreterSettings -> FilePath
tempFilePrefix :: FilePath
tempFilePrefix, FilePath
$sel:fileExtension:ExternalInterpreterSettings :: ExternalInterpreterSettings -> FilePath
fileExtension :: FilePath
fileExtension}
  InterpreterRequest{ChatId
interpreterRequestTelegramChatId :: InterpreterRequest -> ChatId
interpreterRequestTelegramChatId :: ChatId
interpreterRequestTelegramChatId} FilePath
dir =
    let tmpFilepath :: FilePath
tmpFilepath = FilePath
dir
          FilePath -> FilePath -> FilePath
</> FilePath
tempFilePrefix
          FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> ChatId -> FilePath
chatIdToString ChatId
interpreterRequestTelegramChatId
          FilePath -> FilePath -> FilePath
<.> FilePath
fileExtension
    in FilePath
tmpFilepath

-- | Helper to convert Telegram ChatId to 'String' (for filepath).
chatIdToString :: ChatId -> String
chatIdToString :: ChatId -> FilePath
chatIdToString = Integer -> FilePath
forall a. Show a => a -> FilePath
show (Integer -> FilePath) -> (ChatId -> Integer) -> ChatId -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coercible ChatId Integer => ChatId -> Integer
coerce @_ @Integer

-- | Helper to cut filepath from the output.
validate :: FilePath -> ByteString -> ByteString
validate :: FilePath -> ByteString -> ByteString
validate FilePath
path ByteString
bs = Text -> ByteString
textToBS (Text -> Text -> Text -> Text
Text.replace Text
textPath Text
"<bot>" Text
txt)
  where
    textPath :: Text
textPath = FilePath -> Text
Text.pack FilePath
path
    txt :: Text
txt = ByteString -> Text
bsToText ByteString
bs