{-# OPTIONS_GHC -fno-warn-orphans #-}

module Ribosome.Orphans where

import Chiasma.Data.Cmd (Cmds(Cmds))
import Chiasma.Data.Ident (Ident, identText)
import Chiasma.Data.RenderError (RenderError)
import qualified Chiasma.Data.RenderError as RenderError (RenderError(..))
import Chiasma.Data.TmuxError (TmuxError)
import qualified Chiasma.Data.TmuxError as TmuxError (TmuxError(..))
import Chiasma.Data.Views (ViewsError(..))
import Chiasma.Ui.Data.TreeModError (TreeModError(..))
import Chiasma.Ui.Data.View (View(View))
import Control.Monad.Catch (MonadCatch(..), MonadMask(..))
import Neovim.Context.Internal (Neovim(..))
import System.Log.Logger (Priority(ERROR, DEBUG, NOTICE))

import Ribosome.Data.ErrorReport (ErrorReport(ErrorReport))
import Ribosome.Error.Report.Class (ReportError(..))

deriving newtype instance MonadCatch (Neovim e)
deriving newtype instance MonadMask (Neovim e)

invalidOutput :: Text
invalidOutput :: Text
invalidOutput = Text
"invalid output from tmux process"

instance ReportError TmuxError where
  errorReport :: TmuxError -> ErrorReport
errorReport (TmuxError.ProcessFailed (Cmds [Cmd]
cmds) Text
reason) =
    Text -> [Text] -> Priority -> ErrorReport
ErrorReport Text
"fatal error in tmux process" [Text]
log' Priority
ERROR
    where
      log' :: [Text]
log' = [Item [Text]
"tmux process failed:", Text
Item [Text]
reason, Item [Text]
"commands:"] [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> (Cmd -> Text
forall b a. (Show a, IsString b) => a -> b
show (Cmd -> Text) -> [Cmd] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Cmd]
cmds)
  errorReport (TmuxError.OutputParsingFailed (Cmds [Cmd]
cmds) [Text]
output ParseError
parseError) =
    Text -> [Text] -> Priority -> ErrorReport
ErrorReport Text
invalidOutput ([Item [Text]
"tmux output parsing failed:"] [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> (Cmd -> Text
forall b a. (Show a, IsString b) => a -> b
show (Cmd -> Text) -> [Cmd] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Cmd]
cmds) [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Item [Text]
"output:"] [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<>
    [Text]
output [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Item [Text]
"parse error:", ParseError -> Text
forall b a. (Show a, IsString b) => a -> b
show ParseError
parseError]) Priority
ERROR
  errorReport (TmuxError.NoOutput (Cmds [Cmd]
cmds)) =
    Text -> [Text] -> Priority -> ErrorReport
ErrorReport Text
invalidOutput (Text
"no output from tmux process:" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: (Cmd -> Text
forall b a. (Show a, IsString b) => a -> b
show (Cmd -> Text) -> [Cmd] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Cmd]
cmds)) Priority
ERROR
  errorReport (TmuxError.DecodingFailed (Cmds [Cmd]
cmds) Text
output TmuxDecodeError
decodeError) =
    Text -> [Text] -> Priority -> ErrorReport
ErrorReport Text
invalidOutput (Text
"failed to decode tmux process output:" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: (Cmd -> Text
forall b a. (Show a, IsString b) => a -> b
show (Cmd -> Text) -> [Cmd] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Cmd]
cmds) [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Item [Text]
"output:", Text
Item [Text]
output,
      Item [Text]
"decoding error:", TmuxDecodeError -> Text
forall b a. (Show a, IsString b) => a -> b
show TmuxDecodeError
decodeError]) Priority
ERROR
  errorReport (TmuxError.InvalidOutput Text
reason Text
cmd) =
    Text -> [Text] -> Priority -> ErrorReport
ErrorReport Text
invalidOutput [Item [Text]
"invalid output from tmux process:", Text -> Text
forall a. ToText a => a -> Text
toText Text
reason, Text -> Text
forall a. ToText a => a -> Text
toText Text
cmd] Priority
ERROR
  errorReport (TmuxError.CommandFailed Cmds
_ [Text]
err) =
    Text -> [Text] -> Priority -> ErrorReport
ErrorReport Text
invalidOutput (Text
"tmux command failed:" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
err) Priority
ERROR

viewExists :: Text -> View a -> ErrorReport
viewExists :: Text -> View a -> ErrorReport
viewExists Text
desc (View Ident
ident ViewState
_ ViewGeometry
_ a
_) =
  Text -> [Text] -> Priority -> ErrorReport
ErrorReport Text
msg [Text
Item [Text]
msg] Priority
DEBUG
  where
    msg :: Text
msg = Text
"a " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
desc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" with ident `" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Ident -> Text
identText Ident
ident Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"` already exists"

viewMissing :: Text -> Ident -> ErrorReport
viewMissing :: Text -> Ident -> ErrorReport
viewMissing Text
desc Ident
ident =
  Text -> [Text] -> Priority -> ErrorReport
ErrorReport Text
msg [Text
Item [Text]
msg] Priority
DEBUG
  where
    msg :: Text
msg = Text
"no " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
desc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" with ident `" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Ident -> Text
identText Ident
ident Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"`"

ambiguousView :: Text -> Ident -> Int -> ErrorReport
ambiguousView :: Text -> Ident -> Int -> ErrorReport
ambiguousView Text
desc Ident
ident Int
num =
  Text -> [Text] -> Priority -> ErrorReport
ErrorReport Text
msg [Text
Item [Text]
logMsg] Priority
ERROR
  where
    msg :: Text
msg = Text
"there are " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall b a. (Show a, IsString b) => a -> b
show Int
num Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
desc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"s with ident `" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Ident -> Text
identText Ident
ident Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"`"
    logMsg :: Text
logMsg = Text
"ambiguous " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
desc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Ident -> Text
identText Ident
ident Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall b a. (Show a, IsString b) => a -> b
show Int
num Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"

instance ReportError TreeModError where
  errorReport :: TreeModError -> ErrorReport
errorReport (PaneExists PaneView
pane) =
    Text -> PaneView -> ErrorReport
forall a. Text -> View a -> ErrorReport
viewExists Text
"pane" PaneView
pane
  errorReport (LayoutExists LayoutView
layout) =
    Text -> LayoutView -> ErrorReport
forall a. Text -> View a -> ErrorReport
viewExists Text
"layout" LayoutView
layout
  errorReport (PaneMissing Ident
pane) =
    Text -> Ident -> ErrorReport
viewMissing Text
"pane" Ident
pane
  errorReport (LayoutMissing Ident
layout) =
    Text -> Ident -> ErrorReport
viewMissing Text
"layout" Ident
layout
  errorReport (AmbiguousPane Ident
pane Int
num) =
    Text -> Ident -> Int -> ErrorReport
ambiguousView Text
"pane" Ident
pane Int
num
  errorReport (AmbiguousLayout Ident
layout Int
num) =
    Text -> Ident -> Int -> ErrorReport
ambiguousView Text
"layout" Ident
layout Int
num
  errorReport TreeModError
NoTrees =
    Text -> [Text] -> Priority -> ErrorReport
ErrorReport Text
msg [Text
Item [Text]
msg] Priority
DEBUG
    where
      msg :: Text
msg = Text
"no UI layouts have been created"

noSuchView :: Text -> Ident -> ErrorReport
noSuchView :: Text -> Ident -> ErrorReport
noSuchView Text
desc Ident
ident =
  Text -> [Text] -> Priority -> ErrorReport
ErrorReport Text
msg [Text
Item [Text]
msg] Priority
NOTICE
  where
    msg :: Text
msg = Text
"no tmux " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
desc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" with ident `" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Ident -> Text
identText Ident
ident Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"`"

noId :: Text -> Ident -> ErrorReport
noId :: Text -> Ident -> ErrorReport
noId Text
desc Ident
ident =
  Text -> [Text] -> Priority -> ErrorReport
ErrorReport Text
msg [Text
Item [Text]
msg] Priority
ERROR
  where
    msg :: Text
msg = Text
"tmux " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
desc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" with ident `" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Ident -> Text
identText Ident
ident Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"`" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" has no id"

instance ReportError ViewsError where
  errorReport :: ViewsError -> ErrorReport
errorReport (NoSuchSession Ident
ident) =
    Text -> Ident -> ErrorReport
noSuchView Text
"session" Ident
ident
  errorReport (NoSuchWindow Ident
ident) =
    Text -> Ident -> ErrorReport
noSuchView Text
"window" Ident
ident
  errorReport (NoSuchPane Ident
ident) =
    Text -> Ident -> ErrorReport
noSuchView Text
"pane" Ident
ident
  errorReport (NoPaneId Ident
ident) =
    Text -> Ident -> ErrorReport
noId Text
"pane" Ident
ident

instance ReportError RenderError where
  errorReport :: RenderError -> ErrorReport
errorReport (RenderError.NoPrincipal Ident
ident) =
    Text -> [Text] -> Priority -> ErrorReport
ErrorReport Text
"internal render error: no view in layout" [Text
"no principal in " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Ident -> Text
identText Ident
ident] Priority
ERROR
  errorReport (RenderError.Views ViewsError
err) =
    ViewsError -> ErrorReport
forall a. ReportError a => a -> ErrorReport
errorReport ViewsError
err
  errorReport (RenderError.Pack Text
message) =
    Text -> [Text] -> Priority -> ErrorReport
ErrorReport (Text
"error packing a tmux layout: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
forall a. ToText a => a -> Text
toText Text
message) [Item [Text]
"tmux pack error:", Text -> Text
forall a. ToText a => a -> Text
toText Text
message] Priority
ERROR
  errorReport (RenderError.Fatal TmuxError
tmuxError) =
    TmuxError -> ErrorReport
forall a. ReportError a => a -> ErrorReport
errorReport TmuxError
tmuxError