Skip to content

Commit fb8b819

Browse files
committed
Add fourmolu plugin
1 parent 77dda30 commit fb8b819

File tree

4 files changed

+84
-1
lines changed

4 files changed

+84
-1
lines changed

exe/Main.hs

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -94,6 +94,7 @@ import Ide.Plugin.Example2 as Example2
9494
import Ide.Plugin.GhcIde as GhcIde
9595
import Ide.Plugin.Floskell as Floskell
9696
import Ide.Plugin.Ormolu as Ormolu
97+
import Ide.Plugin.Fourmolu as Fourmolu
9798
import Ide.Plugin.StylishHaskell as StylishHaskell
9899
#if AGPL
99100
import Ide.Plugin.Brittany as Brittany
@@ -129,6 +130,7 @@ idePlugins includeExamples = pluginDescToIdePlugins allPlugins
129130
, Floskell.descriptor "floskell"
130131
-- , genericDescriptor "generic"
131132
-- , ghcmodDescriptor "ghcmod"
133+
, Fourmolu.descriptor "fourmolu"
132134
, Ormolu.descriptor "ormolu"
133135
, StylishHaskell.descriptor "stylish-haskell"
134136
#if AGPL

haskell-language-server.cabal

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -44,6 +44,7 @@ library
4444
Ide.Plugin.Config
4545
Ide.Plugin.Example
4646
Ide.Plugin.Example2
47+
Ide.Plugin.Fourmolu
4748
Ide.Plugin.GhcIde
4849
Ide.Plugin.Ormolu
4950
Ide.Plugin.Pragmas
@@ -72,6 +73,7 @@ library
7273
, extra
7374
, filepath
7475
, floskell == 0.10.*
76+
, fourmolu ^>= 0.0.6.0
7577
, ghc
7678
, ghcide >= 0.1
7779
, gitrev

src/Ide/Plugin/Fourmolu.hs

Lines changed: 78 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,78 @@
1+
{-# LANGUAGE PackageImports #-}
2+
{-# LANGUAGE RecordWildCards #-}
3+
{-# LANGUAGE OverloadedStrings #-}
4+
{-# LANGUAGE ScopedTypeVariables #-}
5+
{-# LANGUAGE TypeApplications #-}
6+
{-# LANGUAGE ViewPatterns #-}
7+
8+
module Ide.Plugin.Fourmolu
9+
(
10+
descriptor
11+
, provider
12+
)
13+
where
14+
15+
import Control.Exception
16+
import qualified Data.Text as T
17+
import Development.IDE.Core.Rules
18+
import Development.IDE.Types.Diagnostics as D
19+
import Development.IDE.Types.Location
20+
import qualified DynFlags as D
21+
import qualified EnumSet as S
22+
import GHC
23+
import Ide.Types
24+
import Ide.PluginUtils
25+
import Ide.Plugin.Formatter
26+
import Language.Haskell.LSP.Types
27+
import "fourmolu" Ormolu
28+
import Text.Regex.TDFA.Text()
29+
30+
-- ---------------------------------------------------------------------
31+
32+
descriptor :: PluginId -> PluginDescriptor
33+
descriptor plId = (defaultPluginDescriptor plId)
34+
{ pluginFormattingProvider = Just provider
35+
}
36+
37+
-- ---------------------------------------------------------------------
38+
39+
provider :: FormattingProvider IO
40+
provider _lf ideState typ contents fp _ = do
41+
let
42+
fromDyn :: ParsedModule -> IO [DynOption]
43+
fromDyn pmod =
44+
let
45+
df = ms_hspp_opts $ pm_mod_summary pmod
46+
pp =
47+
let p = D.sPgm_F $ D.settings df
48+
in if null p then [] else ["-pgmF=" <> p]
49+
pm = map (("-fplugin=" <>) . moduleNameString) $ D.pluginModNames df
50+
ex = map (("-X" <>) . show) $ S.toList $ D.extensionFlags df
51+
in
52+
return $ map DynOption $ pp <> pm <> ex
53+
54+
m_parsed <- runAction "Fourmolu" ideState $ getParsedModule fp
55+
fileOpts <- case m_parsed of
56+
Nothing -> return []
57+
Just pm -> fromDyn pm
58+
59+
let
60+
fullRegion = RegionIndices Nothing Nothing
61+
rangeRegion s e = RegionIndices (Just s) (Just e)
62+
mkConf o region = defaultConfig { cfgDynOptions = o, cfgRegion = region }
63+
fmt :: T.Text -> Config RegionIndices -> IO (Either OrmoluException T.Text)
64+
fmt cont conf =
65+
try @OrmoluException (ormolu conf (fromNormalizedFilePath fp) $ T.unpack cont)
66+
67+
case typ of
68+
FormatText -> ret <$> fmt contents (mkConf fileOpts fullRegion)
69+
FormatRange r ->
70+
let
71+
Range (Position sl _) (Position el _) = normalize r
72+
in
73+
ret <$> fmt contents (mkConf fileOpts (rangeRegion sl el))
74+
where
75+
ret :: Either OrmoluException T.Text -> Either ResponseError (List TextEdit)
76+
ret (Left err) = Left
77+
(responseError (T.pack $ "fourmoluCmd: " ++ show err) )
78+
ret (Right new) = Right (makeDiffTextEdit contents new)

src/Ide/Plugin/Ormolu.hs

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,4 @@
1+
{-# LANGUAGE PackageImports #-}
12
{-# LANGUAGE RecordWildCards #-}
23
{-# LANGUAGE OverloadedStrings #-}
34
{-# LANGUAGE ScopedTypeVariables #-}
@@ -23,7 +24,7 @@ import Ide.Types
2324
import Ide.PluginUtils
2425
import Ide.Plugin.Formatter
2526
import Language.Haskell.LSP.Types
26-
import Ormolu
27+
import "ormolu" Ormolu
2728
import Text.Regex.TDFA.Text()
2829

2930
-- ---------------------------------------------------------------------

0 commit comments

Comments
 (0)