Quickfix.hs

{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE RecordWildCards #-}

{- |
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 Prettyprinter (viaShow)

import Neovim.API.String
import Neovim.Classes
import Neovim.Context

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 qs a =
    void $ vim_call_function "setqflist" $ qs +: a +: []

data ColumnNumber
    = VisualColumn Int
    | ByteIndexColumn Int
    | NoColumn
    deriving (Eq, Ord, Show, Generic)

instance NFData ColumnNumber

data SignLocation strType
    = LineNumber Int
    | SearchPattern strType
    deriving (Eq, Ord, Show, 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@.
      bufOrFile :: Either Int strType
    , -- | Line number or search pattern to locate the error.
      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.
      col :: ColumnNumber
    , -- | Error number.
      nr :: Maybe Int
    , -- | Description of the error.
      text :: strType
    , -- | Type of error.
      errorType :: QuickfixErrorType
    }
    deriving (Eq, Show, Generic)

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

-- | Simple error type enum.
data QuickfixErrorType = Warning | Error
    deriving (Eq, Ord, Show, Read, Enum, Bounded, Generic)

instance NFData QuickfixErrorType

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

    fromObject o = case fromObject o :: Either (Doc AnsiStyle) String of
        Right "W" -> return Warning
        Right "E" -> return Error
        _ -> return 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 bufferOrFile lineOrPattern =
    QFItem
        { bufOrFile = bufferOrFile
        , lnumOrPattern = lineOrPattern
        , col = NoColumn
        , nr = Nothing
        , text = mempty
        , errorType = Error
        }

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

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

instance NFData QuickfixAction

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

    fromObject o = case fromObject o of
        Right "a" -> return Append
        Right "r" -> return Replace
        Right s | BS.all (`BS.elem` " \t\n\r") s -> return New
        _ -> Left "Could not convert to QuickfixAction"