{-# LANGUAGE RecordWildCards   #-}
{-# LANGUAGE DeriveGeneric     #-}
{- |
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           Control.Applicative
import           Control.Monad                (void)
import           Data.ByteString              as BS (ByteString, all, elem)
import qualified Data.Map                     as Map
import           Data.Maybe
import           Data.MessagePack
import           Data.Monoid
import           Neovim.API.String
import           Neovim.Classes
import           Neovim.Context
import           Data.Text.Prettyprint.Doc (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 :: [QuickfixListItem strType] -> QuickfixAction -> Neovim env ()
setqflist [QuickfixListItem strType]
qs QuickfixAction
a =
    Neovim env Object -> Neovim env ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Neovim env Object -> Neovim env ())
-> Neovim env Object -> Neovim env ()
forall a b. (a -> b) -> a -> b
$ String -> [Object] -> forall env. Neovim env Object
vim_call_function String
"setqflist" ([Object] -> forall env. Neovim env Object)
-> [Object] -> forall env. Neovim env Object
forall a b. (a -> b) -> a -> b
$ [QuickfixListItem strType]
qs [QuickfixListItem strType] -> [Object] -> [Object]
forall o. NvimObject o => o -> [Object] -> [Object]
+: QuickfixAction
a QuickfixAction -> [Object] -> [Object]
forall o. NvimObject o => o -> [Object] -> [Object]
+: []

data ColumnNumber
    = VisualColumn Int
    | ByteIndexColumn Int
    | NoColumn
  deriving (ColumnNumber -> ColumnNumber -> Bool
(ColumnNumber -> ColumnNumber -> Bool)
-> (ColumnNumber -> ColumnNumber -> Bool) -> Eq ColumnNumber
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
Eq ColumnNumber
-> (ColumnNumber -> ColumnNumber -> Ordering)
-> (ColumnNumber -> ColumnNumber -> Bool)
-> (ColumnNumber -> ColumnNumber -> Bool)
-> (ColumnNumber -> ColumnNumber -> Bool)
-> (ColumnNumber -> ColumnNumber -> Bool)
-> (ColumnNumber -> ColumnNumber -> ColumnNumber)
-> (ColumnNumber -> ColumnNumber -> ColumnNumber)
-> Ord 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
$cp1Ord :: Eq ColumnNumber
Ord, Int -> ColumnNumber -> ShowS
[ColumnNumber] -> ShowS
ColumnNumber -> String
(Int -> ColumnNumber -> ShowS)
-> (ColumnNumber -> String)
-> ([ColumnNumber] -> ShowS)
-> Show ColumnNumber
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. ColumnNumber -> Rep ColumnNumber x)
-> (forall x. Rep ColumnNumber x -> ColumnNumber)
-> Generic ColumnNumber
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
(SignLocation strType -> SignLocation strType -> Bool)
-> (SignLocation strType -> SignLocation strType -> Bool)
-> Eq (SignLocation strType)
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, Eq (SignLocation strType)
Eq (SignLocation strType)
-> (SignLocation strType -> SignLocation strType -> Ordering)
-> (SignLocation strType -> SignLocation strType -> Bool)
-> (SignLocation strType -> SignLocation strType -> Bool)
-> (SignLocation strType -> SignLocation strType -> Bool)
-> (SignLocation strType -> SignLocation strType -> Bool)
-> (SignLocation strType
    -> SignLocation strType -> SignLocation strType)
-> (SignLocation strType
    -> SignLocation strType -> SignLocation strType)
-> Ord (SignLocation strType)
SignLocation strType -> SignLocation strType -> Bool
SignLocation strType -> SignLocation strType -> Ordering
SignLocation strType
-> SignLocation strType -> SignLocation strType
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
$cp1Ord :: forall strType. Ord strType => Eq (SignLocation strType)
Ord, Int -> SignLocation strType -> ShowS
[SignLocation strType] -> ShowS
SignLocation strType -> String
(Int -> SignLocation strType -> ShowS)
-> (SignLocation strType -> String)
-> ([SignLocation strType] -> ShowS)
-> Show (SignLocation strType)
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 x. SignLocation strType -> Rep (SignLocation strType) x)
-> (forall x. Rep (SignLocation strType) x -> SignLocation strType)
-> Generic (SignLocation strType)
forall x. Rep (SignLocation strType) x -> SignLocation strType
forall x. SignLocation strType -> Rep (SignLocation strType) x
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
    { QuickfixListItem strType -> Either Int strType
bufOrFile     :: Either Int strType
    -- ^ Since the filename is only used if no buffer can be specified, this
    -- field is a merge of @bufnr@ and @filename@.

    , QuickfixListItem strType -> Either Int strType
lnumOrPattern :: Either Int strType
    -- ^ Line number or search pattern to locate the error.

    , QuickfixListItem strType -> ColumnNumber
col           :: ColumnNumber
    -- ^ 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.

    , QuickfixListItem strType -> Maybe Int
nr            :: Maybe Int
    -- ^ Error number.

    , QuickfixListItem strType -> strType
text          :: strType
    -- ^ Description of the error.

    , QuickfixListItem strType -> QuickfixErrorType
errorType     :: QuickfixErrorType
    -- ^ Type of error.
    } deriving (QuickfixListItem strType -> QuickfixListItem strType -> Bool
(QuickfixListItem strType -> QuickfixListItem strType -> Bool)
-> (QuickfixListItem strType -> QuickfixListItem strType -> Bool)
-> Eq (QuickfixListItem strType)
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
[QuickfixListItem strType] -> ShowS
QuickfixListItem strType -> String
(Int -> QuickfixListItem strType -> ShowS)
-> (QuickfixListItem strType -> String)
-> ([QuickfixListItem strType] -> ShowS)
-> Show (QuickfixListItem strType)
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 x.
 QuickfixListItem strType -> Rep (QuickfixListItem strType) x)
-> (forall x.
    Rep (QuickfixListItem strType) x -> QuickfixListItem strType)
-> Generic (QuickfixListItem strType)
forall x.
Rep (QuickfixListItem strType) x -> QuickfixListItem strType
forall x.
QuickfixListItem strType -> Rep (QuickfixListItem strType) x
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
(QuickfixErrorType -> QuickfixErrorType -> Bool)
-> (QuickfixErrorType -> QuickfixErrorType -> Bool)
-> Eq QuickfixErrorType
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
Eq QuickfixErrorType
-> (QuickfixErrorType -> QuickfixErrorType -> Ordering)
-> (QuickfixErrorType -> QuickfixErrorType -> Bool)
-> (QuickfixErrorType -> QuickfixErrorType -> Bool)
-> (QuickfixErrorType -> QuickfixErrorType -> Bool)
-> (QuickfixErrorType -> QuickfixErrorType -> Bool)
-> (QuickfixErrorType -> QuickfixErrorType -> QuickfixErrorType)
-> (QuickfixErrorType -> QuickfixErrorType -> QuickfixErrorType)
-> Ord 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
$cp1Ord :: Eq QuickfixErrorType
Ord, Int -> QuickfixErrorType -> ShowS
[QuickfixErrorType] -> ShowS
QuickfixErrorType -> String
(Int -> QuickfixErrorType -> ShowS)
-> (QuickfixErrorType -> String)
-> ([QuickfixErrorType] -> ShowS)
-> Show QuickfixErrorType
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]
(Int -> ReadS QuickfixErrorType)
-> ReadS [QuickfixErrorType]
-> ReadPrec QuickfixErrorType
-> ReadPrec [QuickfixErrorType]
-> Read 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]
(QuickfixErrorType -> QuickfixErrorType)
-> (QuickfixErrorType -> QuickfixErrorType)
-> (Int -> QuickfixErrorType)
-> (QuickfixErrorType -> Int)
-> (QuickfixErrorType -> [QuickfixErrorType])
-> (QuickfixErrorType -> QuickfixErrorType -> [QuickfixErrorType])
-> (QuickfixErrorType -> QuickfixErrorType -> [QuickfixErrorType])
-> (QuickfixErrorType
    -> QuickfixErrorType -> QuickfixErrorType -> [QuickfixErrorType])
-> Enum 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
QuickfixErrorType -> QuickfixErrorType -> Bounded QuickfixErrorType
forall a. a -> a -> Bounded a
maxBound :: QuickfixErrorType
$cmaxBound :: QuickfixErrorType
minBound :: QuickfixErrorType
$cminBound :: QuickfixErrorType
Bounded, (forall x. QuickfixErrorType -> Rep QuickfixErrorType x)
-> (forall x. Rep QuickfixErrorType x -> QuickfixErrorType)
-> Generic QuickfixErrorType
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 Object -> Either (Doc AnsiStyle) String
forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject Object
o :: Either (Doc AnsiStyle) String of
        Right String
"W" -> QuickfixErrorType -> Either (Doc AnsiStyle) QuickfixErrorType
forall (m :: * -> *) a. Monad m => a -> m a
return QuickfixErrorType
Warning
        Right String
"E" -> QuickfixErrorType -> Either (Doc AnsiStyle) QuickfixErrorType
forall (m :: * -> *) a. Monad m => a -> m a
return QuickfixErrorType
Error
        Either (Doc AnsiStyle) String
_         -> QuickfixErrorType -> Either (Doc AnsiStyle) QuickfixErrorType
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)
                 => Either Int strType -- ^ buffer of file name
                 -> Either Int strType -- ^ line number or pattern
                 -> QuickfixListItem strType
quickfixListItem :: Either Int strType
-> Either Int strType -> QuickfixListItem strType
quickfixListItem Either Int strType
bufferOrFile Either Int strType
lineOrPattern = QFItem :: forall strType.
Either Int strType
-> Either Int strType
-> ColumnNumber
-> Maybe Int
-> strType
-> QuickfixErrorType
-> QuickfixListItem strType
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 = Maybe Int
forall a. Maybe a
Nothing
    , text :: strType
text = strType
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
..} =
        (Map ByteString Object -> Object
forall o. NvimObject o => o -> Object
toObject :: Map.Map ByteString Object -> Object) (Map ByteString Object -> Object)
-> ([(ByteString, Object)] -> Map ByteString Object)
-> [(ByteString, Object)]
-> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(ByteString, Object)] -> Map ByteString Object
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(ByteString, Object)] -> Object)
-> [(ByteString, Object)] -> Object
forall a b. (a -> b) -> a -> b
$
            [ (Int -> (ByteString, Object))
-> (strType -> (ByteString, Object))
-> Either Int strType
-> (ByteString, Object)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\Int
b -> (ByteString
"bufnr", Int -> Object
forall o. NvimObject o => o -> Object
toObject Int
b))
                     (\strType
f -> (ByteString
"filename", strType -> Object
forall o. NvimObject o => o -> Object
toObject strType
f))
                     Either Int strType
bufOrFile
            , (Int -> (ByteString, Object))
-> (strType -> (ByteString, Object))
-> Either Int strType
-> (ByteString, Object)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\Int
l -> (ByteString
"lnum", Int -> Object
forall o. NvimObject o => o -> Object
toObject Int
l))
                     (\strType
p -> (ByteString
"pattern", strType -> Object
forall o. NvimObject o => o -> Object
toObject strType
p))
                     Either Int strType
lnumOrPattern
            , (ByteString
"type", QuickfixErrorType -> Object
forall o. NvimObject o => o -> Object
toObject QuickfixErrorType
errorType)
            , (ByteString
"text", strType -> Object
forall o. NvimObject o => o -> Object
toObject strType
text)
            ] [(ByteString, Object)]
-> [(ByteString, Object)] -> [(ByteString, Object)]
forall a. [a] -> [a] -> [a]
++ [[(ByteString, Object)]] -> [(ByteString, Object)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
            [ case ColumnNumber
col of
                ColumnNumber
NoColumn -> []
                ByteIndexColumn Int
i -> [ (ByteString
"col", Int -> Object
forall o. NvimObject o => o -> Object
toObject Int
i), (ByteString
"vcol", Bool -> Object
forall o. NvimObject o => o -> Object
toObject Bool
False) ]
                VisualColumn Int
i -> [ (ByteString
"col", Int -> Object
forall o. NvimObject o => o -> Object
toObject Int
i), (ByteString
"vcol", Bool -> Object
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 <- Object -> Either (Doc AnsiStyle) (Map ByteString Object)
forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject Object
objectMap
        let l :: NvimObject o => ByteString -> Either (Doc AnsiStyle) o
            l :: ByteString -> Either (Doc AnsiStyle) o
l ByteString
key = case ByteString -> Map ByteString Object -> Maybe Object
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ByteString
key Map ByteString Object
m of
                Just Object
o -> Object -> Either (Doc AnsiStyle) o
forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject Object
o
                Maybe Object
Nothing -> Doc AnsiStyle -> Either (Doc AnsiStyle) o
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Doc AnsiStyle -> Either (Doc AnsiStyle) o)
-> Doc AnsiStyle -> Either (Doc AnsiStyle) o
forall a b. (a -> b) -> a -> b
$ Doc AnsiStyle
"Key not found."
        Either Int strType
bufOrFile <- case (ByteString -> Either (Doc AnsiStyle) Int
forall o. NvimObject o => ByteString -> Either (Doc AnsiStyle) o
l ByteString
"bufnr", ByteString -> Either (Doc AnsiStyle) strType
forall o. NvimObject o => ByteString -> Either (Doc AnsiStyle) o
l ByteString
"filename") of
            (Right Int
b, Either (Doc AnsiStyle) strType
_) -> Either Int strType -> Either (Doc AnsiStyle) (Either Int strType)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Int strType -> Either (Doc AnsiStyle) (Either Int strType))
-> Either Int strType
-> Either (Doc AnsiStyle) (Either Int strType)
forall a b. (a -> b) -> a -> b
$ Int -> Either Int strType
forall a b. a -> Either a b
Left Int
b
            (Either (Doc AnsiStyle) Int
_, Right strType
f) -> Either Int strType -> Either (Doc AnsiStyle) (Either Int strType)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Int strType -> Either (Doc AnsiStyle) (Either Int strType))
-> Either Int strType
-> Either (Doc AnsiStyle) (Either Int strType)
forall a b. (a -> b) -> a -> b
$ strType -> Either Int strType
forall a b. b -> Either a b
Right strType
f
            (Either (Doc AnsiStyle) Int, Either (Doc AnsiStyle) strType)
_           -> Doc AnsiStyle -> Either (Doc AnsiStyle) (Either Int strType)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Doc AnsiStyle -> Either (Doc AnsiStyle) (Either Int strType))
-> Doc AnsiStyle -> Either (Doc AnsiStyle) (Either Int strType)
forall a b. (a -> b) -> a -> b
$ Doc AnsiStyle
"No buffer number or file name inside quickfix list item."
        Either Int strType
lnumOrPattern <- case (ByteString -> Either (Doc AnsiStyle) Int
forall o. NvimObject o => ByteString -> Either (Doc AnsiStyle) o
l ByteString
"lnum", ByteString -> Either (Doc AnsiStyle) strType
forall o. NvimObject o => ByteString -> Either (Doc AnsiStyle) o
l ByteString
"pattern") of
            (Right Int
lnum, Either (Doc AnsiStyle) strType
_) -> Either Int strType -> Either (Doc AnsiStyle) (Either Int strType)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Int strType -> Either (Doc AnsiStyle) (Either Int strType))
-> Either Int strType
-> Either (Doc AnsiStyle) (Either Int strType)
forall a b. (a -> b) -> a -> b
$ Int -> Either Int strType
forall a b. a -> Either a b
Left Int
lnum
            (Either (Doc AnsiStyle) Int
_, Right strType
pat)  -> Either Int strType -> Either (Doc AnsiStyle) (Either Int strType)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Int strType -> Either (Doc AnsiStyle) (Either Int strType))
-> Either Int strType
-> Either (Doc AnsiStyle) (Either Int strType)
forall a b. (a -> b) -> a -> b
$ strType -> Either Int strType
forall a b. b -> Either a b
Right strType
pat
            (Either (Doc AnsiStyle) Int, Either (Doc AnsiStyle) strType)
_              -> Doc AnsiStyle -> Either (Doc AnsiStyle) (Either Int strType)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Doc AnsiStyle -> Either (Doc AnsiStyle) (Either Int strType))
-> Doc AnsiStyle -> Either (Doc AnsiStyle) (Either Int strType)
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' :: ByteString -> Either (Doc AnsiStyle) (Maybe o)
l' ByteString
key = case ByteString -> Map ByteString Object -> Maybe Object
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ByteString
key Map ByteString Object
m of
                Just Object
o -> o -> Maybe o
forall a. a -> Maybe a
Just (o -> Maybe o)
-> Either (Doc AnsiStyle) o -> Either (Doc AnsiStyle) (Maybe o)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Either (Doc AnsiStyle) o
forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject Object
o
                Maybe Object
Nothing -> Maybe o -> Either (Doc AnsiStyle) (Maybe o)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe o
forall a. Maybe a
Nothing
        Maybe Int
nr <- ByteString -> Either (Doc AnsiStyle) (Maybe Int)
forall o.
NvimObject o =>
ByteString -> Either (Doc AnsiStyle) (Maybe o)
l' ByteString
"nr" Either (Doc AnsiStyle) (Maybe Int)
-> (Maybe Int -> Either (Doc AnsiStyle) (Maybe Int))
-> Either (Doc AnsiStyle) (Maybe Int)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                Just Int
0 -> Maybe Int -> Either (Doc AnsiStyle) (Maybe Int)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Int
forall a. Maybe a
Nothing
                Maybe Int
nr' -> Maybe Int -> Either (Doc AnsiStyle) (Maybe Int)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Int
nr'
        Maybe Int
c <- ByteString -> Either (Doc AnsiStyle) (Maybe Int)
forall o.
NvimObject o =>
ByteString -> Either (Doc AnsiStyle) (Maybe o)
l' ByteString
"col"
        Maybe Bool
v <- ByteString -> Either (Doc AnsiStyle) (Maybe Bool)
forall o.
NvimObject o =>
ByteString -> Either (Doc AnsiStyle) (Maybe o)
l' ByteString
"vcol"
        let col :: ColumnNumber
col = ColumnNumber
-> (ColumnNumber -> ColumnNumber)
-> Maybe ColumnNumber
-> ColumnNumber
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ColumnNumber
NoColumn ColumnNumber -> ColumnNumber
forall a. a -> a
id (Maybe ColumnNumber -> ColumnNumber)
-> Maybe ColumnNumber -> ColumnNumber
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
_) -> ColumnNumber -> Maybe ColumnNumber
forall (m :: * -> *) a. Monad m => a -> m a
return (ColumnNumber -> Maybe ColumnNumber)
-> ColumnNumber -> Maybe ColumnNumber
forall a b. (a -> b) -> a -> b
$ ColumnNumber
NoColumn
                    (Int
_, Bool
True) -> ColumnNumber -> Maybe ColumnNumber
forall (m :: * -> *) a. Monad m => a -> m a
return (ColumnNumber -> Maybe ColumnNumber)
-> ColumnNumber -> Maybe ColumnNumber
forall a b. (a -> b) -> a -> b
$ Int -> ColumnNumber
VisualColumn Int
c'
                    (Int
_, Bool
False) -> ColumnNumber -> Maybe ColumnNumber
forall (m :: * -> *) a. Monad m => a -> m a
return (ColumnNumber -> Maybe ColumnNumber)
-> ColumnNumber -> Maybe ColumnNumber
forall a b. (a -> b) -> a -> b
$ Int -> ColumnNumber
ByteIndexColumn Int
c'
        strType
text <- strType -> Maybe strType -> strType
forall a. a -> Maybe a -> a
fromMaybe strType
forall a. Monoid a => a
mempty (Maybe strType -> strType)
-> Either (Doc AnsiStyle) (Maybe strType)
-> Either (Doc AnsiStyle) strType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Either (Doc AnsiStyle) (Maybe strType)
forall o.
NvimObject o =>
ByteString -> Either (Doc AnsiStyle) (Maybe o)
l' ByteString
"text"
        QuickfixErrorType
errorType <- QuickfixErrorType -> Maybe QuickfixErrorType -> QuickfixErrorType
forall a. a -> Maybe a -> a
fromMaybe QuickfixErrorType
Error (Maybe QuickfixErrorType -> QuickfixErrorType)
-> Either (Doc AnsiStyle) (Maybe QuickfixErrorType)
-> Either (Doc AnsiStyle) QuickfixErrorType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Either (Doc AnsiStyle) (Maybe QuickfixErrorType)
forall o.
NvimObject o =>
ByteString -> Either (Doc AnsiStyle) (Maybe o)
l' ByteString
"type"
        QuickfixListItem strType
-> Either (Doc AnsiStyle) (QuickfixListItem strType)
forall (m :: * -> *) a. Monad m => a -> m a
return QFItem :: forall strType.
Either Int strType
-> Either Int strType
-> ColumnNumber
-> Maybe Int
-> strType
-> QuickfixErrorType
-> QuickfixListItem strType
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 = Doc AnsiStyle -> Either (Doc AnsiStyle) (QuickfixListItem strType)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Doc AnsiStyle
 -> Either (Doc AnsiStyle) (QuickfixListItem strType))
-> Doc AnsiStyle
-> Either (Doc AnsiStyle) (QuickfixListItem strType)
forall a b. (a -> b) -> a -> b
$ Doc AnsiStyle
"Could not deserialize QuickfixListItem,"
                                 Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
"expected a map but received:"
                                 Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Object -> Doc AnsiStyle
forall a ann. Show a => a -> Doc ann
viaShow Object
o


data QuickfixAction
    = Append -- ^ Add items to the current list (or create a new one if none exists).
    | Replace -- ^ Replace current list (or create a new one if none exists).
    | New    -- ^ Create a new list.
    deriving (QuickfixAction -> QuickfixAction -> Bool
(QuickfixAction -> QuickfixAction -> Bool)
-> (QuickfixAction -> QuickfixAction -> Bool) -> Eq QuickfixAction
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
Eq QuickfixAction
-> (QuickfixAction -> QuickfixAction -> Ordering)
-> (QuickfixAction -> QuickfixAction -> Bool)
-> (QuickfixAction -> QuickfixAction -> Bool)
-> (QuickfixAction -> QuickfixAction -> Bool)
-> (QuickfixAction -> QuickfixAction -> Bool)
-> (QuickfixAction -> QuickfixAction -> QuickfixAction)
-> (QuickfixAction -> QuickfixAction -> QuickfixAction)
-> Ord 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
$cp1Ord :: Eq QuickfixAction
Ord, Int -> QuickfixAction
QuickfixAction -> Int
QuickfixAction -> [QuickfixAction]
QuickfixAction -> QuickfixAction
QuickfixAction -> QuickfixAction -> [QuickfixAction]
QuickfixAction
-> QuickfixAction -> QuickfixAction -> [QuickfixAction]
(QuickfixAction -> QuickfixAction)
-> (QuickfixAction -> QuickfixAction)
-> (Int -> QuickfixAction)
-> (QuickfixAction -> Int)
-> (QuickfixAction -> [QuickfixAction])
-> (QuickfixAction -> QuickfixAction -> [QuickfixAction])
-> (QuickfixAction -> QuickfixAction -> [QuickfixAction])
-> (QuickfixAction
    -> QuickfixAction -> QuickfixAction -> [QuickfixAction])
-> Enum 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
QuickfixAction -> QuickfixAction -> Bounded QuickfixAction
forall a. a -> a -> Bounded a
maxBound :: QuickfixAction
$cmaxBound :: QuickfixAction
minBound :: QuickfixAction
$cminBound :: QuickfixAction
Bounded, Int -> QuickfixAction -> ShowS
[QuickfixAction] -> ShowS
QuickfixAction -> String
(Int -> QuickfixAction -> ShowS)
-> (QuickfixAction -> String)
-> ([QuickfixAction] -> ShowS)
-> Show QuickfixAction
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. QuickfixAction -> Rep QuickfixAction x)
-> (forall x. Rep QuickfixAction x -> QuickfixAction)
-> Generic QuickfixAction
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 Object -> Either (Doc AnsiStyle) ByteString
forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject Object
o of
        Right ByteString
"a" -> QuickfixAction -> Either (Doc AnsiStyle) QuickfixAction
forall (m :: * -> *) a. Monad m => a -> m a
return QuickfixAction
Append
        Right ByteString
"r" -> QuickfixAction -> Either (Doc AnsiStyle) QuickfixAction
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 -> QuickfixAction -> Either (Doc AnsiStyle) QuickfixAction
forall (m :: * -> *) a. Monad m => a -> m a
return QuickfixAction
New
        Either (Doc AnsiStyle) ByteString
_   -> Doc AnsiStyle -> Either (Doc AnsiStyle) QuickfixAction
forall a b. a -> Either a b
Left Doc AnsiStyle
"Could not convert to QuickfixAction"