{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}

{- |
Module      :  Neovim.Quickfix
Description :  API for interacting with the quickfix list
Copyright   :  (c) Sebastian Witte
License     :  Apache-2.0

Maintainer  :  woozletoff@gmail.com
Stability   :  experimental
Portability :  GHC
-}
module Neovim.Quickfix where

import Neovim.API.String ( vim_call_function )
import Neovim.Classes
    ( Generic,
      NFData,
      (<+>),
      Doc,
      AnsiStyle,
      NvimObject(toObject, fromObject),
      (+:) )
import Neovim.Context ( throwError, Neovim )


import Control.Monad (void)
import Data.ByteString as BS (ByteString, all, elem)
import qualified Data.Map as Map
import Data.Maybe ( fromMaybe )
import Data.MessagePack ( Object(ObjectBinary, ObjectMap) )
import Prettyprinter (viaShow)
import Prelude

{- | This is a wrapper around neovim's @setqflist()@. @strType@ can be any
 string that you can append to (hence 'Monoid') that is also an instance
 of 'NvimObject'. You can e.g. use the plain old 'String'.
-}
setqflist ::
    (Monoid strType, NvimObject strType) =>
    [QuickfixListItem strType] ->
    QuickfixAction ->
    Neovim env ()
setqflist :: forall strType env.
(Monoid strType, NvimObject strType) =>
[QuickfixListItem strType] -> QuickfixAction -> Neovim env ()
setqflist [QuickfixListItem strType]
qs QuickfixAction
a =
    forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall env. String -> [Object] -> Neovim env Object
vim_call_function String
"setqflist" forall a b. (a -> b) -> a -> b
$ [QuickfixListItem strType]
qs forall o. NvimObject o => o -> [Object] -> [Object]
+: QuickfixAction
a forall o. NvimObject o => o -> [Object] -> [Object]
+: []

data ColumnNumber
    = VisualColumn Int
    | ByteIndexColumn Int
    | NoColumn
    deriving (ColumnNumber -> ColumnNumber -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ColumnNumber -> ColumnNumber -> Bool
$c/= :: ColumnNumber -> ColumnNumber -> Bool
== :: ColumnNumber -> ColumnNumber -> Bool
$c== :: ColumnNumber -> ColumnNumber -> Bool
Eq, Eq ColumnNumber
ColumnNumber -> ColumnNumber -> Bool
ColumnNumber -> ColumnNumber -> Ordering
ColumnNumber -> ColumnNumber -> ColumnNumber
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ColumnNumber -> ColumnNumber -> ColumnNumber
$cmin :: ColumnNumber -> ColumnNumber -> ColumnNumber
max :: ColumnNumber -> ColumnNumber -> ColumnNumber
$cmax :: ColumnNumber -> ColumnNumber -> ColumnNumber
>= :: ColumnNumber -> ColumnNumber -> Bool
$c>= :: ColumnNumber -> ColumnNumber -> Bool
> :: ColumnNumber -> ColumnNumber -> Bool
$c> :: ColumnNumber -> ColumnNumber -> Bool
<= :: ColumnNumber -> ColumnNumber -> Bool
$c<= :: ColumnNumber -> ColumnNumber -> Bool
< :: ColumnNumber -> ColumnNumber -> Bool
$c< :: ColumnNumber -> ColumnNumber -> Bool
compare :: ColumnNumber -> ColumnNumber -> Ordering
$ccompare :: ColumnNumber -> ColumnNumber -> Ordering
Ord, Int -> ColumnNumber -> ShowS
[ColumnNumber] -> ShowS
ColumnNumber -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ColumnNumber] -> ShowS
$cshowList :: [ColumnNumber] -> ShowS
show :: ColumnNumber -> String
$cshow :: ColumnNumber -> String
showsPrec :: Int -> ColumnNumber -> ShowS
$cshowsPrec :: Int -> ColumnNumber -> ShowS
Show, forall x. Rep ColumnNumber x -> ColumnNumber
forall x. ColumnNumber -> Rep ColumnNumber x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ColumnNumber x -> ColumnNumber
$cfrom :: forall x. ColumnNumber -> Rep ColumnNumber x
Generic)

instance NFData ColumnNumber

data SignLocation strType
    = LineNumber Int
    | SearchPattern strType
    deriving (SignLocation strType -> SignLocation strType -> Bool
forall strType.
Eq strType =>
SignLocation strType -> SignLocation strType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SignLocation strType -> SignLocation strType -> Bool
$c/= :: forall strType.
Eq strType =>
SignLocation strType -> SignLocation strType -> Bool
== :: SignLocation strType -> SignLocation strType -> Bool
$c== :: forall strType.
Eq strType =>
SignLocation strType -> SignLocation strType -> Bool
Eq, SignLocation strType -> SignLocation strType -> Bool
SignLocation strType -> SignLocation strType -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {strType}. Ord strType => Eq (SignLocation strType)
forall strType.
Ord strType =>
SignLocation strType -> SignLocation strType -> Bool
forall strType.
Ord strType =>
SignLocation strType -> SignLocation strType -> Ordering
forall strType.
Ord strType =>
SignLocation strType
-> SignLocation strType -> SignLocation strType
min :: SignLocation strType
-> SignLocation strType -> SignLocation strType
$cmin :: forall strType.
Ord strType =>
SignLocation strType
-> SignLocation strType -> SignLocation strType
max :: SignLocation strType
-> SignLocation strType -> SignLocation strType
$cmax :: forall strType.
Ord strType =>
SignLocation strType
-> SignLocation strType -> SignLocation strType
>= :: SignLocation strType -> SignLocation strType -> Bool
$c>= :: forall strType.
Ord strType =>
SignLocation strType -> SignLocation strType -> Bool
> :: SignLocation strType -> SignLocation strType -> Bool
$c> :: forall strType.
Ord strType =>
SignLocation strType -> SignLocation strType -> Bool
<= :: SignLocation strType -> SignLocation strType -> Bool
$c<= :: forall strType.
Ord strType =>
SignLocation strType -> SignLocation strType -> Bool
< :: SignLocation strType -> SignLocation strType -> Bool
$c< :: forall strType.
Ord strType =>
SignLocation strType -> SignLocation strType -> Bool
compare :: SignLocation strType -> SignLocation strType -> Ordering
$ccompare :: forall strType.
Ord strType =>
SignLocation strType -> SignLocation strType -> Ordering
Ord, Int -> SignLocation strType -> ShowS
forall strType.
Show strType =>
Int -> SignLocation strType -> ShowS
forall strType. Show strType => [SignLocation strType] -> ShowS
forall strType. Show strType => SignLocation strType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SignLocation strType] -> ShowS
$cshowList :: forall strType. Show strType => [SignLocation strType] -> ShowS
show :: SignLocation strType -> String
$cshow :: forall strType. Show strType => SignLocation strType -> String
showsPrec :: Int -> SignLocation strType -> ShowS
$cshowsPrec :: forall strType.
Show strType =>
Int -> SignLocation strType -> ShowS
Show, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall strType x.
Rep (SignLocation strType) x -> SignLocation strType
forall strType x.
SignLocation strType -> Rep (SignLocation strType) x
$cto :: forall strType x.
Rep (SignLocation strType) x -> SignLocation strType
$cfrom :: forall strType x.
SignLocation strType -> Rep (SignLocation strType) x
Generic)

instance (NFData strType) => NFData (SignLocation strType)

{- | Quickfix list item. The parameter names should mostly conform to those in
 @:h setqflist()@. Some fields are merged to explicitly state mutually
 exclusive elements or some other behavior of the fields.

 see 'quickfixListItem' for creating a value of this type without typing too
 much.
-}
data QuickfixListItem strType = QFItem
    { -- | Since the filename is only used if no buffer can be specified, this
      -- field is a merge of @bufnr@ and @filename@.
      forall strType. QuickfixListItem strType -> Either Int strType
bufOrFile :: Either Int strType
    , -- | Line number or search pattern to locate the error.
      forall strType. QuickfixListItem strType -> Either Int strType
lnumOrPattern :: Either Int strType
    , -- | A tuple of a column number and a boolean indicating which kind of
      -- indexing should be used. 'True' means that the visual column should be
      -- used. 'False' means to use the byte index.
      forall strType. QuickfixListItem strType -> ColumnNumber
col :: ColumnNumber
    , -- | Error number.
      forall strType. QuickfixListItem strType -> Maybe Int
nr :: Maybe Int
    , -- | Description of the error.
      forall strType. QuickfixListItem strType -> strType
text :: strType
    , -- | Type of error.
      forall strType. QuickfixListItem strType -> QuickfixErrorType
errorType :: QuickfixErrorType
    }
    deriving (QuickfixListItem strType -> QuickfixListItem strType -> Bool
forall strType.
Eq strType =>
QuickfixListItem strType -> QuickfixListItem strType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: QuickfixListItem strType -> QuickfixListItem strType -> Bool
$c/= :: forall strType.
Eq strType =>
QuickfixListItem strType -> QuickfixListItem strType -> Bool
== :: QuickfixListItem strType -> QuickfixListItem strType -> Bool
$c== :: forall strType.
Eq strType =>
QuickfixListItem strType -> QuickfixListItem strType -> Bool
Eq, Int -> QuickfixListItem strType -> ShowS
forall strType.
Show strType =>
Int -> QuickfixListItem strType -> ShowS
forall strType. Show strType => [QuickfixListItem strType] -> ShowS
forall strType. Show strType => QuickfixListItem strType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [QuickfixListItem strType] -> ShowS
$cshowList :: forall strType. Show strType => [QuickfixListItem strType] -> ShowS
show :: QuickfixListItem strType -> String
$cshow :: forall strType. Show strType => QuickfixListItem strType -> String
showsPrec :: Int -> QuickfixListItem strType -> ShowS
$cshowsPrec :: forall strType.
Show strType =>
Int -> QuickfixListItem strType -> ShowS
Show, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall strType x.
Rep (QuickfixListItem strType) x -> QuickfixListItem strType
forall strType x.
QuickfixListItem strType -> Rep (QuickfixListItem strType) x
$cto :: forall strType x.
Rep (QuickfixListItem strType) x -> QuickfixListItem strType
$cfrom :: forall strType x.
QuickfixListItem strType -> Rep (QuickfixListItem strType) x
Generic)

instance (NFData strType) => NFData (QuickfixListItem strType)

-- | Simple error type enum.
data QuickfixErrorType = Warning | Error
    deriving (QuickfixErrorType -> QuickfixErrorType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: QuickfixErrorType -> QuickfixErrorType -> Bool
$c/= :: QuickfixErrorType -> QuickfixErrorType -> Bool
== :: QuickfixErrorType -> QuickfixErrorType -> Bool
$c== :: QuickfixErrorType -> QuickfixErrorType -> Bool
Eq, Eq QuickfixErrorType
QuickfixErrorType -> QuickfixErrorType -> Bool
QuickfixErrorType -> QuickfixErrorType -> Ordering
QuickfixErrorType -> QuickfixErrorType -> QuickfixErrorType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: QuickfixErrorType -> QuickfixErrorType -> QuickfixErrorType
$cmin :: QuickfixErrorType -> QuickfixErrorType -> QuickfixErrorType
max :: QuickfixErrorType -> QuickfixErrorType -> QuickfixErrorType
$cmax :: QuickfixErrorType -> QuickfixErrorType -> QuickfixErrorType
>= :: QuickfixErrorType -> QuickfixErrorType -> Bool
$c>= :: QuickfixErrorType -> QuickfixErrorType -> Bool
> :: QuickfixErrorType -> QuickfixErrorType -> Bool
$c> :: QuickfixErrorType -> QuickfixErrorType -> Bool
<= :: QuickfixErrorType -> QuickfixErrorType -> Bool
$c<= :: QuickfixErrorType -> QuickfixErrorType -> Bool
< :: QuickfixErrorType -> QuickfixErrorType -> Bool
$c< :: QuickfixErrorType -> QuickfixErrorType -> Bool
compare :: QuickfixErrorType -> QuickfixErrorType -> Ordering
$ccompare :: QuickfixErrorType -> QuickfixErrorType -> Ordering
Ord, Int -> QuickfixErrorType -> ShowS
[QuickfixErrorType] -> ShowS
QuickfixErrorType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [QuickfixErrorType] -> ShowS
$cshowList :: [QuickfixErrorType] -> ShowS
show :: QuickfixErrorType -> String
$cshow :: QuickfixErrorType -> String
showsPrec :: Int -> QuickfixErrorType -> ShowS
$cshowsPrec :: Int -> QuickfixErrorType -> ShowS
Show, ReadPrec [QuickfixErrorType]
ReadPrec QuickfixErrorType
Int -> ReadS QuickfixErrorType
ReadS [QuickfixErrorType]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [QuickfixErrorType]
$creadListPrec :: ReadPrec [QuickfixErrorType]
readPrec :: ReadPrec QuickfixErrorType
$creadPrec :: ReadPrec QuickfixErrorType
readList :: ReadS [QuickfixErrorType]
$creadList :: ReadS [QuickfixErrorType]
readsPrec :: Int -> ReadS QuickfixErrorType
$creadsPrec :: Int -> ReadS QuickfixErrorType
Read, Int -> QuickfixErrorType
QuickfixErrorType -> Int
QuickfixErrorType -> [QuickfixErrorType]
QuickfixErrorType -> QuickfixErrorType
QuickfixErrorType -> QuickfixErrorType -> [QuickfixErrorType]
QuickfixErrorType
-> QuickfixErrorType -> QuickfixErrorType -> [QuickfixErrorType]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: QuickfixErrorType
-> QuickfixErrorType -> QuickfixErrorType -> [QuickfixErrorType]
$cenumFromThenTo :: QuickfixErrorType
-> QuickfixErrorType -> QuickfixErrorType -> [QuickfixErrorType]
enumFromTo :: QuickfixErrorType -> QuickfixErrorType -> [QuickfixErrorType]
$cenumFromTo :: QuickfixErrorType -> QuickfixErrorType -> [QuickfixErrorType]
enumFromThen :: QuickfixErrorType -> QuickfixErrorType -> [QuickfixErrorType]
$cenumFromThen :: QuickfixErrorType -> QuickfixErrorType -> [QuickfixErrorType]
enumFrom :: QuickfixErrorType -> [QuickfixErrorType]
$cenumFrom :: QuickfixErrorType -> [QuickfixErrorType]
fromEnum :: QuickfixErrorType -> Int
$cfromEnum :: QuickfixErrorType -> Int
toEnum :: Int -> QuickfixErrorType
$ctoEnum :: Int -> QuickfixErrorType
pred :: QuickfixErrorType -> QuickfixErrorType
$cpred :: QuickfixErrorType -> QuickfixErrorType
succ :: QuickfixErrorType -> QuickfixErrorType
$csucc :: QuickfixErrorType -> QuickfixErrorType
Enum, QuickfixErrorType
forall a. a -> a -> Bounded a
maxBound :: QuickfixErrorType
$cmaxBound :: QuickfixErrorType
minBound :: QuickfixErrorType
$cminBound :: QuickfixErrorType
Bounded, forall x. Rep QuickfixErrorType x -> QuickfixErrorType
forall x. QuickfixErrorType -> Rep QuickfixErrorType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep QuickfixErrorType x -> QuickfixErrorType
$cfrom :: forall x. QuickfixErrorType -> Rep QuickfixErrorType x
Generic)

instance NFData QuickfixErrorType

instance NvimObject QuickfixErrorType where
    toObject :: QuickfixErrorType -> Object
toObject = \case
        QuickfixErrorType
Warning -> ByteString -> Object
ObjectBinary ByteString
"W"
        QuickfixErrorType
Error -> ByteString -> Object
ObjectBinary ByteString
"E"

    fromObject :: Object -> Either (Doc AnsiStyle) QuickfixErrorType
fromObject Object
o = case forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject Object
o :: Either (Doc AnsiStyle) String of
        Right String
"W" -> forall (m :: * -> *) a. Monad m => a -> m a
return QuickfixErrorType
Warning
        Right String
"E" -> forall (m :: * -> *) a. Monad m => a -> m a
return QuickfixErrorType
Error
        Either (Doc AnsiStyle) String
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return QuickfixErrorType
Error

{- | Create a 'QuickfixListItem' by providing the minimal amount of arguments
 needed.
-}
quickfixListItem ::
    (Monoid strType) =>
    -- | buffer of file name
    Either Int strType ->
    -- | line number or pattern
    Either Int strType ->
    QuickfixListItem strType
quickfixListItem :: forall strType.
Monoid strType =>
Either Int strType
-> Either Int strType -> QuickfixListItem strType
quickfixListItem Either Int strType
bufferOrFile Either Int strType
lineOrPattern =
    QFItem
        { bufOrFile :: Either Int strType
bufOrFile = Either Int strType
bufferOrFile
        , lnumOrPattern :: Either Int strType
lnumOrPattern = Either Int strType
lineOrPattern
        , col :: ColumnNumber
col = ColumnNumber
NoColumn
        , nr :: Maybe Int
nr = forall a. Maybe a
Nothing
        , text :: strType
text = forall a. Monoid a => a
mempty
        , errorType :: QuickfixErrorType
errorType = QuickfixErrorType
Error
        }

instance
    (Monoid strType, NvimObject strType) =>
    NvimObject (QuickfixListItem strType)
    where
    toObject :: QuickfixListItem strType -> Object
toObject QFItem{strType
Maybe Int
Either Int strType
QuickfixErrorType
ColumnNumber
errorType :: QuickfixErrorType
text :: strType
nr :: Maybe Int
col :: ColumnNumber
lnumOrPattern :: Either Int strType
bufOrFile :: Either Int strType
errorType :: forall strType. QuickfixListItem strType -> QuickfixErrorType
text :: forall strType. QuickfixListItem strType -> strType
nr :: forall strType. QuickfixListItem strType -> Maybe Int
col :: forall strType. QuickfixListItem strType -> ColumnNumber
lnumOrPattern :: forall strType. QuickfixListItem strType -> Either Int strType
bufOrFile :: forall strType. QuickfixListItem strType -> Either Int strType
..} =
        (forall o. NvimObject o => o -> Object
toObject :: Map.Map ByteString Object -> Object) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$
            [ forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
                (\Int
b -> (ByteString
"bufnr", forall o. NvimObject o => o -> Object
toObject Int
b))
                (\strType
f -> (ByteString
"filename", forall o. NvimObject o => o -> Object
toObject strType
f))
                Either Int strType
bufOrFile
            , forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
                (\Int
l -> (ByteString
"lnum", forall o. NvimObject o => o -> Object
toObject Int
l))
                (\strType
p -> (ByteString
"pattern", forall o. NvimObject o => o -> Object
toObject strType
p))
                Either Int strType
lnumOrPattern
            , (ByteString
"type", forall o. NvimObject o => o -> Object
toObject QuickfixErrorType
errorType)
            , (ByteString
"text", forall o. NvimObject o => o -> Object
toObject strType
text)
            ]
                forall a. [a] -> [a] -> [a]
++ case ColumnNumber
col of
                    ColumnNumber
NoColumn -> []
                    ByteIndexColumn Int
i -> [(ByteString
"col", forall o. NvimObject o => o -> Object
toObject Int
i), (ByteString
"vcol", forall o. NvimObject o => o -> Object
toObject Bool
False)]
                    VisualColumn Int
i -> [(ByteString
"col", forall o. NvimObject o => o -> Object
toObject Int
i), (ByteString
"vcol", forall o. NvimObject o => o -> Object
toObject Bool
True)]

    fromObject :: Object -> Either (Doc AnsiStyle) (QuickfixListItem strType)
fromObject objectMap :: Object
objectMap@(ObjectMap Map Object Object
_) = do
        Map ByteString Object
m <- forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject Object
objectMap
        let l :: NvimObject o => ByteString -> Either (Doc AnsiStyle) o
            l :: forall o. NvimObject o => ByteString -> Either (Doc AnsiStyle) o
l ByteString
key = case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ByteString
key Map ByteString Object
m of
                Just Object
o -> forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject Object
o
                Maybe Object
Nothing -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ Doc AnsiStyle
"Key not found."
        Either Int strType
bufOrFile <- case (forall o. NvimObject o => ByteString -> Either (Doc AnsiStyle) o
l ByteString
"bufnr", forall o. NvimObject o => ByteString -> Either (Doc AnsiStyle) o
l ByteString
"filename") of
            (Right Int
b, Either (Doc AnsiStyle) strType
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left Int
b
            (Either (Doc AnsiStyle) Int
_, Right strType
f) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right strType
f
            (Either (Doc AnsiStyle) Int, Either (Doc AnsiStyle) strType)
_ -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ Doc AnsiStyle
"No buffer number or file name inside quickfix list item."
        Either Int strType
lnumOrPattern <- case (forall o. NvimObject o => ByteString -> Either (Doc AnsiStyle) o
l ByteString
"lnum", forall o. NvimObject o => ByteString -> Either (Doc AnsiStyle) o
l ByteString
"pattern") of
            (Right Int
lnum, Either (Doc AnsiStyle) strType
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left Int
lnum
            (Either (Doc AnsiStyle) Int
_, Right strType
pat) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right strType
pat
            (Either (Doc AnsiStyle) Int, Either (Doc AnsiStyle) strType)
_ -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ Doc AnsiStyle
"No line number or search pattern inside quickfix list item."
        let l' :: NvimObject o => ByteString -> Either (Doc AnsiStyle) (Maybe o)
            l' :: forall o.
NvimObject o =>
ByteString -> Either (Doc AnsiStyle) (Maybe o)
l' ByteString
key = case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ByteString
key Map ByteString Object
m of
                Just Object
o -> forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject Object
o
                Maybe Object
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
        Maybe Int
nr <-
            forall o.
NvimObject o =>
ByteString -> Either (Doc AnsiStyle) (Maybe o)
l' ByteString
"nr" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                Just Int
0 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
                Maybe Int
nr' -> forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Int
nr'
        Maybe Int
c <- forall o.
NvimObject o =>
ByteString -> Either (Doc AnsiStyle) (Maybe o)
l' ByteString
"col"
        Maybe Bool
v <- forall o.
NvimObject o =>
ByteString -> Either (Doc AnsiStyle) (Maybe o)
l' ByteString
"vcol"
        let col :: ColumnNumber
col = forall a. a -> Maybe a -> a
fromMaybe ColumnNumber
NoColumn forall a b. (a -> b) -> a -> b
$ do
                Int
c' <- Maybe Int
c
                Bool
v' <- Maybe Bool
v
                case (Int
c', Bool
v') of
                    (Int
0, Bool
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return ColumnNumber
NoColumn
                    (Int
_, Bool
True) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int -> ColumnNumber
VisualColumn Int
c'
                    (Int
_, Bool
False) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int -> ColumnNumber
ByteIndexColumn Int
c'
        strType
text <- forall a. a -> Maybe a -> a
fromMaybe forall a. Monoid a => a
mempty forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall o.
NvimObject o =>
ByteString -> Either (Doc AnsiStyle) (Maybe o)
l' ByteString
"text"
        QuickfixErrorType
errorType <- forall a. a -> Maybe a -> a
fromMaybe QuickfixErrorType
Error forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall o.
NvimObject o =>
ByteString -> Either (Doc AnsiStyle) (Maybe o)
l' ByteString
"type"
        forall (m :: * -> *) a. Monad m => a -> m a
return QFItem{strType
Maybe Int
Either Int strType
QuickfixErrorType
ColumnNumber
errorType :: QuickfixErrorType
text :: strType
col :: ColumnNumber
nr :: Maybe Int
lnumOrPattern :: Either Int strType
bufOrFile :: Either Int strType
errorType :: QuickfixErrorType
text :: strType
nr :: Maybe Int
col :: ColumnNumber
lnumOrPattern :: Either Int strType
bufOrFile :: Either Int strType
..}
    fromObject Object
o =
        forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$
            Doc AnsiStyle
"Could not deserialize QuickfixListItem,"
                forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
"expected a map but received:"
                forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Show a => a -> Doc ann
viaShow Object
o

data QuickfixAction
    = -- | Add items to the current list (or create a new one if none exists).
      Append
    | -- | Replace current list (or create a new one if none exists).
      Replace
    | -- | Create a new list.
      New
    deriving (QuickfixAction -> QuickfixAction -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: QuickfixAction -> QuickfixAction -> Bool
$c/= :: QuickfixAction -> QuickfixAction -> Bool
== :: QuickfixAction -> QuickfixAction -> Bool
$c== :: QuickfixAction -> QuickfixAction -> Bool
Eq, Eq QuickfixAction
QuickfixAction -> QuickfixAction -> Bool
QuickfixAction -> QuickfixAction -> Ordering
QuickfixAction -> QuickfixAction -> QuickfixAction
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: QuickfixAction -> QuickfixAction -> QuickfixAction
$cmin :: QuickfixAction -> QuickfixAction -> QuickfixAction
max :: QuickfixAction -> QuickfixAction -> QuickfixAction
$cmax :: QuickfixAction -> QuickfixAction -> QuickfixAction
>= :: QuickfixAction -> QuickfixAction -> Bool
$c>= :: QuickfixAction -> QuickfixAction -> Bool
> :: QuickfixAction -> QuickfixAction -> Bool
$c> :: QuickfixAction -> QuickfixAction -> Bool
<= :: QuickfixAction -> QuickfixAction -> Bool
$c<= :: QuickfixAction -> QuickfixAction -> Bool
< :: QuickfixAction -> QuickfixAction -> Bool
$c< :: QuickfixAction -> QuickfixAction -> Bool
compare :: QuickfixAction -> QuickfixAction -> Ordering
$ccompare :: QuickfixAction -> QuickfixAction -> Ordering
Ord, Int -> QuickfixAction
QuickfixAction -> Int
QuickfixAction -> [QuickfixAction]
QuickfixAction -> QuickfixAction
QuickfixAction -> QuickfixAction -> [QuickfixAction]
QuickfixAction
-> QuickfixAction -> QuickfixAction -> [QuickfixAction]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: QuickfixAction
-> QuickfixAction -> QuickfixAction -> [QuickfixAction]
$cenumFromThenTo :: QuickfixAction
-> QuickfixAction -> QuickfixAction -> [QuickfixAction]
enumFromTo :: QuickfixAction -> QuickfixAction -> [QuickfixAction]
$cenumFromTo :: QuickfixAction -> QuickfixAction -> [QuickfixAction]
enumFromThen :: QuickfixAction -> QuickfixAction -> [QuickfixAction]
$cenumFromThen :: QuickfixAction -> QuickfixAction -> [QuickfixAction]
enumFrom :: QuickfixAction -> [QuickfixAction]
$cenumFrom :: QuickfixAction -> [QuickfixAction]
fromEnum :: QuickfixAction -> Int
$cfromEnum :: QuickfixAction -> Int
toEnum :: Int -> QuickfixAction
$ctoEnum :: Int -> QuickfixAction
pred :: QuickfixAction -> QuickfixAction
$cpred :: QuickfixAction -> QuickfixAction
succ :: QuickfixAction -> QuickfixAction
$csucc :: QuickfixAction -> QuickfixAction
Enum, QuickfixAction
forall a. a -> a -> Bounded a
maxBound :: QuickfixAction
$cmaxBound :: QuickfixAction
minBound :: QuickfixAction
$cminBound :: QuickfixAction
Bounded, Int -> QuickfixAction -> ShowS
[QuickfixAction] -> ShowS
QuickfixAction -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [QuickfixAction] -> ShowS
$cshowList :: [QuickfixAction] -> ShowS
show :: QuickfixAction -> String
$cshow :: QuickfixAction -> String
showsPrec :: Int -> QuickfixAction -> ShowS
$cshowsPrec :: Int -> QuickfixAction -> ShowS
Show, forall x. Rep QuickfixAction x -> QuickfixAction
forall x. QuickfixAction -> Rep QuickfixAction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep QuickfixAction x -> QuickfixAction
$cfrom :: forall x. QuickfixAction -> Rep QuickfixAction x
Generic)

instance NFData QuickfixAction

instance NvimObject QuickfixAction where
    toObject :: QuickfixAction -> Object
toObject = \case
        QuickfixAction
Append -> ByteString -> Object
ObjectBinary ByteString
"a"
        QuickfixAction
Replace -> ByteString -> Object
ObjectBinary ByteString
"r"
        QuickfixAction
New -> ByteString -> Object
ObjectBinary ByteString
""

    fromObject :: Object -> Either (Doc AnsiStyle) QuickfixAction
fromObject Object
o = case forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject Object
o of
        Right ByteString
"a" -> forall (m :: * -> *) a. Monad m => a -> m a
return QuickfixAction
Append
        Right ByteString
"r" -> forall (m :: * -> *) a. Monad m => a -> m a
return QuickfixAction
Replace
        Right ByteString
s | (Word8 -> Bool) -> ByteString -> Bool
BS.all (Word8 -> ByteString -> Bool
`BS.elem` ByteString
" \t\n\r") ByteString
s -> forall (m :: * -> *) a. Monad m => a -> m a
return QuickfixAction
New
        Either (Doc AnsiStyle) ByteString
_ -> forall a b. a -> Either a b
Left Doc AnsiStyle
"Could not convert to QuickfixAction"