-- Copyright 2016 Evan Laforge
-- This program is distributed under the terms of the GNU General Public
-- License 3.0, see COPYING or http://www.gnu.org/licenses/gpl-3.0.txt

-- | Define the protocol between the sequencer's repl port and the repl client.
module App.ReplProtocol (
    -- * types
    Query(..), NotifySeq(..)
    , Response(..)
    , CmdResult(..), Result(..), Editor(..), File(..)
    , FileType(..), file_type_extension
    , empty_result, error_result, raw

    -- * repl protocol
    , initialize
    , query_cmd, query_save_file, query_completion
    , notify
    , query_cmd_simple

    -- * seq protocol
    , seq_receive, seq_send

    -- * format
    , format_result
    , abbreviate_package_loads
) where
import qualified Control.DeepSeq as DeepSeq
import qualified Control.Exception as Exception
import qualified Data.ByteString as ByteString
import qualified Data.Text as Text
import qualified Network.Socket as Socket
import qualified System.IO as IO
import qualified System.IO.Error as IO.Error
import qualified System.Posix as Posix

import qualified Util.Log as Log
import qualified Util.Network as Network
import qualified Util.PPrint as PPrint
import qualified Util.Seq as Seq
import qualified Util.Serialize as Serialize
import           Util.Serialize (get, get_tag, put, put_tag)

import qualified App.Config as Config

import           Global


-- | This is a simple RPC mechanism.  'Query' goes to the server, which
-- responds with the matching 'Response'.
data Query =
    QSaveFile
    | QCommand !Text
    | QCompletion !Text
    -- | A notification doesn't have a corrpesponding 'Response'.
    | QNotify !NotifySeq
    deriving (Eq, Show)

data NotifySeq =
    -- | These are so the sequencer knows if there are open editors, so it
    -- can refuse to quit and hence orphan them.
    NEditorOpened | NEditorClosed
    deriving (Eq, Show)

data Response =
    RSaveFile !(Maybe FilePath) -- ^ current save file
    | RCommand !CmdResult
    | RCompletion ![Text] -- ^ possible completions for the prefix
    deriving (Eq, Show)

instance Pretty Query where
    pretty = \case
        QSaveFile -> "SaveFile"
        QCommand t -> "Command: " <> t
        QCompletion t -> "Completion: " <> t
        QNotify notify -> showt notify

data CmdResult = CmdResult !Result ![Log.Msg]
    deriving (Eq, Show)

data Result =
    Raw !Text -- ^ Print this text directly, without formatting it.
    | Format !Text -- ^ Format and print.
    | Edit !(NonEmpty Editor) -- ^ Edit one or more files.
    deriving (Eq, Show)

-- | Open an editor locally.
--
-- How this works is that a Cmd will return the special 'Edit' value, which
-- will be specially interpreted in the repl to open an editor.  The editor
-- will be configured such that when it saves, it will send its buffer to
-- the sequencer via a REPL function with a string argument (configured by
-- '_on_save').  The text goes back separately via the @send@ command, since
-- the REPL itself will be blocked waiting for the editor to exit.
data Editor = Editor {
    _file :: !File
    -- | Start editing on this line.
    , _line_number :: !Int
    -- | Send QCommands when the editor saves or quits.  A %s is replaced by
    -- the edited text.
    , _on_save :: !(Maybe Text)
    -- | Send on an explicit send cmd, @gs@ in vim.
    , _on_send :: !(Maybe Text)
    } deriving (Eq, Show)

data File =
    FileName !FilePath -- ^ open this file
    | Text !FileType !Text -- ^ open this text in a temp file
    deriving (Eq, Show)

data FileType = NoType | Ky | TScore
    deriving (Eq, Show, Bounded, Enum)

file_type_extension :: FileType -> String
file_type_extension = \case
    NoType -> ""
    Ky -> ".ky"
    TScore -> ".tscore"

empty_result :: Result
empty_result = Raw ""

error_result :: Text -> CmdResult
error_result msg = CmdResult empty_result [Log.msg Log.Error Nothing msg]

raw :: Text -> CmdResult
raw msg = CmdResult (Raw msg) []

-- * repl protocol

initialize :: IO a -> IO a
initialize app = Socket.withSocketsDo $ do
    Posix.installHandler Posix.sigPIPE (Posix.Catch sigpipe) Nothing
    app
    where
    sigpipe = IO.hPutStrLn IO.stderr
        "caught SIGPIPE, reader must have closed the socket"

-- | Client send and receive.
query :: Network.Addr -> Query -> IO (Either Exception.IOException Response)
query addr query = Exception.try $ Network.withConnection addr $ \hdl -> do
    repl_send hdl query
    IO.hFlush hdl
    repl_receive hdl

-- | Like 'query', but don't expect a response.
notify :: Network.Addr -> NotifySeq -> IO (Either Exception.IOException ())
notify addr notify = Exception.try $ Network.withConnection addr $ \hdl -> do
    repl_send hdl $ QNotify notify
    IO.hFlush hdl

-- | Send a 'QCommand'.
query_cmd :: Network.Addr -> Text -> IO CmdResult
query_cmd addr cmd = query addr (QCommand cmd) >>= return . \case
    Right (RCommand result) -> result
    Right response -> raw $ "unexpected response: " <> showt response
    Left exc -> raw $ "exception: " <> showt exc

-- | A simple one-shot 'query_cmd'.
query_cmd_simple :: Text -> IO Text
query_cmd_simple cmd = format_result <$> query_cmd Config.repl_socket cmd

-- | Ask for the current save filename.  Nothing for an error, and Just Nothing
-- for no save file.
query_save_file :: Network.Addr -> IO (Maybe (Maybe FilePath))
query_save_file addr = query addr QSaveFile >>= \case
    Right (RSaveFile fname) -> return (Just fname)
    Left exc | IO.Error.isDoesNotExistError exc -> return Nothing
    response -> do
        Log.error $ "unexpected response to QSaveFile: " <> showt response
        return Nothing

query_completion :: Network.Addr -> Text -> IO [Text]
query_completion addr prefix = query addr (QCompletion prefix) >>= \case
    Right (RCompletion words) -> return words
    Left exc | IO.Error.isDoesNotExistError exc -> return []
    response -> do
        Log.error $ "unexpected response to QCompletion: " <> showt response
        return []

-- * low level implementation

-- Specialize 'send' and 'receive' to keep types consistent between seq and
-- repl.

seq_receive :: IO.Handle -> IO Query
seq_receive = receive

seq_send :: IO.Handle -> Response -> IO ()
seq_send = send

repl_send :: IO.Handle -> Query -> IO ()
repl_send = send

repl_receive :: IO.Handle -> IO Response
repl_receive = receive

-- | Write a msg size and then the msg.
send :: Serialize.Serialize a => IO.Handle -> a -> IO ()
send hdl msg = do
    ByteString.hPut hdl (Serialize.encode (ByteString.length bytes))
    ByteString.hPut hdl bytes
    where bytes = Serialize.encode msg

receive :: Serialize.Serialize a => IO.Handle -> IO a
receive hdl = do
    let int_bytes = ByteString.length (Serialize.encode (0 :: Int))
    size <- ByteString.hGet hdl int_bytes
    -- If the app just quit, say because it got a 'quit' cmd, the accept loop
    -- will continue to live long enough to accept another query, but then
    -- close the socket.  A proper fix might be to block the accept loop while
    -- it handles a cmd, but it's a tiny corner case and this seems to do just
    -- as well.
    when (size == "") $
        Exception.throwIO $ IO.Error.mkIOError IO.Error.doesNotExistErrorType
            "client closed handle" Nothing Nothing
    size <- either (errorIO . txt) return (Serialize.decode size)
    either (errorIO . txt) return . Serialize.decode
        =<< ByteString.hGet hdl size

-- * format

-- | Format the response and strip trailing whitespace.
format_result :: CmdResult -> Text
format_result (CmdResult response logs_) =
    Text.stripEnd $ Text.unlines $
        (if null logs then [] else "Logs:" : map pretty logs ++ [""])
            ++ [format response]
    where logs = abbreviate_package_loads logs_

format :: Result -> Text
format (Raw val) = val
format (Format val) = txt $ PPrint.format_str $ untxt val
format (Edit editors) = "Edit: " <> showt (fmap _file editors)

abbreviate_package_loads :: [Log.Msg] -> [Log.Msg]
abbreviate_package_loads logs = loaded ++ filter (not . package_log) logs
    where
    loaded =
        [ Log.msg Log.Notice Nothing $
            "Loaded " <> Text.pack (show packages) <> " packages"
        | packages > 0
        ]
    packages =
        Seq.count (("Loading package" `Text.isPrefixOf`) . Log.msg_text) logs
    package_log log = any (`Text.isPrefixOf` Log.msg_text log)
        ["Loading package", "linking ...", "done."]

-- * instances

instance Serialize.Serialize Query where
    put QSaveFile = put_tag 0
    put (QCommand a) = put_tag 1 >> put a
    put (QCompletion a) = put_tag 2 >> put a
    put (QNotify a) = put_tag 3 >> put a
    get = get_tag >>= \case
        0 -> return QSaveFile
        1 -> QCommand <$> get
        2 -> QCompletion <$> get
        3 -> QNotify <$> get
        tag -> Serialize.bad_tag "Query" tag

instance Serialize.Serialize NotifySeq where
    put = \case
        NEditorOpened -> put_tag 0
        NEditorClosed -> put_tag 1
    get = get_tag >>= \case
        0 -> return NEditorOpened
        1 -> return NEditorClosed
        tag -> Serialize.bad_tag "NotifySeq" tag

instance Serialize.Serialize Response where
    put (RSaveFile a) = put_tag 0 >> put a
    put (RCommand a) = put_tag 1 >> put a
    put (RCompletion a) = put_tag 2 >> put a
    get = get_tag >>= \case
        0 -> RSaveFile <$> get
        1 -> RCommand <$> get
        2 -> RCompletion <$> get
        tag -> Serialize.bad_tag "Response" tag

instance Serialize.Serialize CmdResult where
    put (CmdResult a b) = put a >> put b
    get = CmdResult <$> get <*> get

instance Serialize.Serialize Result where
    put (Raw a) = put_tag 0 >> put a
    put (Format a) = put_tag 1 >> put a
    put (Edit a) = put_tag 2 >> put a
    get = get_tag >>= \case
        0 -> Raw <$> get
        1 -> Format <$> get
        2 -> Edit <$> get
        tag -> Serialize.bad_tag "Result" tag

instance Serialize.Serialize Editor where
    put (Editor a b c d) = put a >> put b >> put c >> put d
    get = Editor <$> get <*> get <*> get <*> get

instance Serialize.Serialize File where
    put (FileName a) = put_tag 0 >> put a
    put (Text a b) = put_tag 1 >> put a >> put b
    get = get_tag >>= \case
        0 -> FileName <$> get
        1 -> Text <$> get <*> get
        tag -> Serialize.bad_tag "File" tag

instance Serialize.Serialize FileType where
    put = Serialize.put_enum
    get = Serialize.get_enum

instance DeepSeq.NFData CmdResult where
    rnf (CmdResult a b) = a `seq` b `seq` ()