packages feed

hls-cabal-plugin-2.1.0.0: src/Ide/Plugin/Cabal/Completion/Completer/Snippet.hs

{-# LANGUAGE OverloadedStrings #-}

module Ide.Plugin.Cabal.Completion.Completer.Snippet where

import           Control.Lens                                 ((?~))
import           Control.Monad.Extra                          (mapMaybeM)
import           Data.Function                                ((&))
import           Data.Map                                     (Map)
import qualified Data.Map                                     as Map
import qualified Data.Text                                    as T
import           Ide.Logger                                   (Priority (..),
                                                               logWith)
import           Ide.Plugin.Cabal.Completion.Completer.Simple
import           Ide.Plugin.Cabal.Completion.Completer.Types
import           Ide.Plugin.Cabal.Completion.Types
import qualified Language.LSP.Protocol.Lens                   as JL
import qualified Language.LSP.Protocol.Types                  as LSP
import qualified Text.Fuzzy.Parallel                          as Fuzzy

-- | Maps snippet triggerwords with their completers
snippetCompleter :: Completer
snippetCompleter recorder cData = do
  let scored = Fuzzy.simpleFilter Fuzzy.defChunkSize Fuzzy.defMaxResults (completionPrefix prefInfo) $ Map.keys snippets
  mapMaybeM
    ( \compl -> do
        let matched = Fuzzy.original compl
        let completion' = Map.lookup matched snippets
        case completion' of
          Nothing -> do
            logWith recorder Warning $ LogMapLookUpOfKnownKeyFailed matched
            pure Nothing
          Just completion ->
            pure $ Just $ mkSnippetCompletion completion matched
    )
    scored
  where
    snippets = snippetMap prefInfo
    prefInfo = cabalPrefixInfo cData
    mkSnippetCompletion :: T.Text -> T.Text -> LSP.CompletionItem
    mkSnippetCompletion insertText toDisplay =
      mkDefaultCompletionItem toDisplay
        & JL.kind ?~ LSP.CompletionItemKind_Snippet
        & JL.insertText ?~ insertText
        & JL.insertTextFormat ?~ LSP.InsertTextFormat_Snippet

type TriggerWord = T.Text

snippetMap :: CabalPrefixInfo -> Map TriggerWord T.Text
snippetMap prefInfo =
  fmap T.unlines $
    Map.fromList
      [ ( "library-snippet",
          [ "library",
            "  hs-source-dirs: $1",
            "  exposed-modules: $2",
            "  build-depends: base",
            "  default-language: Haskell2010"
          ]
        ),
        ( "recommended-fields",
          [ "cabal-version: $1",
            "name: " <> completionFileName prefInfo,
            "version: 0.1.0.0",
            "maintainer: $4",
            "category: $5",
            "synopsis: $6",
            "license: $7",
            "build-type: Simple"
          ]
        ),
        ( "executable-snippet",
          [ "executable $1",
            "  main-is: ${2:Main.hs}",
            "  build-depends: base"
          ]
        ),
        ( "benchmark-snippet",
          [ "benchmark $1",
            "  type: exitcode-stdio-1.0",
            "  main-is: ${3:Main.hs}",
            "  build-depends: base"
          ]
        ),
        ( "testsuite-snippet",
          [ "test-suite $1",
            "  type: exitcode-stdio-1.0",
            "  main-is: ${3:Main.hs}",
            "  build-depends: base"
          ]
        ),
        ( "common-warnings",
          [ "common warnings",
            "  ghc-options: -Wall"
          ]
        ),
        ( "source-repo-github-snippet",
          [ "source-repository head",
            "  type: git",
            "  location: git://github.com/$2"
          ]
        ),
        ( "source-repo-git-snippet",
          [ "source-repository head",
            "  type: git",
            "  location: $1"
          ]
        )
      ]