mirror of
https://github.com/tweag/ormolu.git
synced 2024-09-11 13:16:13 +03:00
Allow to specify module re-exports in .ormolu files
It turns out that gaining knowledge of all module re-exports in the ecosystem is tricky because the Hoogle database does not contain this information, so one would need to download all 14+k packages from Hackage and parse their source code. We've decided that perhaps hardcoding some common re-exports and otherwise giving the users a way to make Ormolu aware of arbitrary important re-exports is a satisfactory solution for now. Co-authored-by: amesgen <alexander.esgen@tweag.io>
This commit is contained in:
parent
b89c0890e0
commit
8f2bc36705
@ -5,6 +5,11 @@
|
||||
892](https://github.com/tweag/ormolu/issues/892) and [issue
|
||||
929](https://github.com/tweag/ormolu/issues/929).
|
||||
|
||||
* Ormolu can now be made aware of module re-exports through either special
|
||||
declarations in `.ormolu` files (see the readme for a description of the
|
||||
syntax), or on the command line with the `--reexport`/`-r` option. [Issue
|
||||
1017](https://github.com/tweag/ormolu/issues/1017).
|
||||
|
||||
* Consistently format `do` blocks/`case`s/`MultiWayIf`s with 4 spaces if and
|
||||
only if they occur as the applicand. [Issue
|
||||
1002](https://github.com/tweag/ormolu/issues/1002) and [issue
|
||||
|
22
README.md
22
README.md
@ -187,12 +187,32 @@ infixl 4 <*>, <*, *>, <**>
|
||||
It uses exactly the same syntax as usual Haskell fixity declarations to make
|
||||
it easier for Haskellers to edit and maintain.
|
||||
|
||||
Besides, all of the above-mentioned parameters can be controlled from the
|
||||
As of Ormolu 0.7.0.0, `.ormolu` files can also contain instructions about
|
||||
module re-exports that Ormolu should be aware of. This might be desirable
|
||||
because at the moment Ormolu cannot know about all possible module
|
||||
re-exports in the ecosystem and only few of them are actually important when
|
||||
it comes to fixity deduction. In 99% of cases the user won't have to do
|
||||
anything, especially since most common re-exports are already programmed
|
||||
into Ormolu. (You are welcome to open PRs to make Ormolu aware of more
|
||||
re-exports by default.) However, when the fixity of an operator is not
|
||||
inferred correctly, making Ormolu aware of a re-export may come in handy.
|
||||
Here is an example:
|
||||
|
||||
```haskell
|
||||
module Control.Lens exports Control.Lens.At
|
||||
module Control.Lens exports Control.Lens.Lens
|
||||
```
|
||||
|
||||
Module re-export declarations can be mixed freely with fixity overrides, as
|
||||
long as each declaration is on its own line.
|
||||
|
||||
Finally, all of the above-mentioned parameters can be controlled from the
|
||||
command line:
|
||||
|
||||
* Language extensions can be specified with the `-o` or `--ghc-opt` flag.
|
||||
* Dependencies can be specified with the `-p` or `--package` flag.
|
||||
* Fixities can be specified with the `-f` or `--fixity` flag.
|
||||
* Re-exports can be specified with the `-r` or `--reexport` flag.
|
||||
|
||||
Searching for both `.cabal` and `.ormolu` files can be disabled by passing
|
||||
`--no-cabal`.
|
||||
|
32
app/Main.hs
32
app/Main.hs
@ -11,20 +11,22 @@ import Control.Exception (throwIO)
|
||||
import Control.Monad
|
||||
import Data.Bool (bool)
|
||||
import Data.List (intercalate, sort)
|
||||
import Data.List.NonEmpty (NonEmpty)
|
||||
import Data.Map.Strict qualified as Map
|
||||
import Data.Maybe (fromMaybe, mapMaybe, maybeToList)
|
||||
import Data.Set qualified as Set
|
||||
import Data.Text.IO qualified as TIO
|
||||
import Data.Version (showVersion)
|
||||
import Distribution.ModuleName (ModuleName)
|
||||
import Language.Haskell.TH.Env (envQ)
|
||||
import Options.Applicative
|
||||
import Ormolu
|
||||
import Ormolu.Diff.Text (diffText, printTextDiff)
|
||||
import Ormolu.Fixity (FixityInfo, FixityOverrides (..), OpName)
|
||||
import Ormolu.Fixity
|
||||
import Ormolu.Parser (manualExts)
|
||||
import Ormolu.Terminal
|
||||
import Ormolu.Utils (showOutputable)
|
||||
import Ormolu.Utils.Fixity (parseFixityDeclarationStr)
|
||||
import Ormolu.Utils.Fixity
|
||||
import Ormolu.Utils.IO
|
||||
import Paths_ormolu (version)
|
||||
import System.Directory
|
||||
@ -158,8 +160,16 @@ formatOne CabalOpts {..} mode reqSourceType rawConfig mpath =
|
||||
fromMaybe
|
||||
ModuleSource
|
||||
(reqSourceType <|> mdetectedSourceType)
|
||||
mfixityOverrides <- traverse getFixityOverridesForSourceFile mcabalInfo
|
||||
return (refineConfig sourceType mcabalInfo mfixityOverrides rawConfig)
|
||||
mdotOrmolu <- traverse parseDotOrmoluForSourceFile mcabalInfo
|
||||
let mfixityOverrides = fst <$> mdotOrmolu
|
||||
mmoduleReexports = snd <$> mdotOrmolu
|
||||
return $
|
||||
refineConfig
|
||||
sourceType
|
||||
mcabalInfo
|
||||
mfixityOverrides
|
||||
mmoduleReexports
|
||||
rawConfig
|
||||
handleDiff originalInput formattedInput fileRepr =
|
||||
case diffText originalInput formattedInput fileRepr of
|
||||
Nothing -> return ExitSuccess
|
||||
@ -292,6 +302,16 @@ configParser =
|
||||
metavar "FIXITY",
|
||||
help "Fixity declaration to use (an override)"
|
||||
]
|
||||
<*> ( fmap (ModuleReexports . Map.fromListWith (<>) . mconcat . pure)
|
||||
. many
|
||||
. option parseModuleReexportDeclaration
|
||||
. mconcat
|
||||
)
|
||||
[ long "reexport",
|
||||
short 'r',
|
||||
metavar "REEXPORT",
|
||||
help "Module re-export that Ormolu should know about"
|
||||
]
|
||||
<*> (fmap Set.fromList . many . strOption . mconcat)
|
||||
[ long "package",
|
||||
short 'p',
|
||||
@ -361,6 +381,10 @@ parseMode = eitherReader $ \case
|
||||
parseFixityDeclaration :: ReadM [(OpName, FixityInfo)]
|
||||
parseFixityDeclaration = eitherReader parseFixityDeclarationStr
|
||||
|
||||
-- | Parse a module reexport declaration.
|
||||
parseModuleReexportDeclaration :: ReadM (ModuleName, NonEmpty ModuleName)
|
||||
parseModuleReexportDeclaration = eitherReader parseModuleReexportDeclarationStr
|
||||
|
||||
-- | Parse 'ColorMode'.
|
||||
parseColorMode :: ReadM ColorMode
|
||||
parseColorMode = eitherReader $ \case
|
||||
|
@ -1,4 +1,4 @@
|
||||
import Control.Lens.Operators
|
||||
import Control.Lens
|
||||
|
||||
lenses =
|
||||
Just $
|
||||
|
@ -1,4 +1,4 @@
|
||||
import Control.Lens.Operators
|
||||
import Control.Lens
|
||||
|
||||
lenses = Just $ M.fromList
|
||||
$ "type" .= ("user.connection" :: Text)
|
||||
|
@ -10,15 +10,13 @@ module Hoogle
|
||||
where
|
||||
|
||||
import Control.Monad (void)
|
||||
import Data.Char (isAlphaNum)
|
||||
import Data.Foldable (asum)
|
||||
import Data.Text (Text)
|
||||
import Data.Void (Void)
|
||||
import Distribution.ModuleName (ModuleName)
|
||||
import Distribution.ModuleName qualified as ModuleName
|
||||
import Distribution.Types.PackageName (PackageName, mkPackageName)
|
||||
import Distribution.Types.PackageName (PackageName)
|
||||
import Ormolu.Fixity
|
||||
import Ormolu.Fixity.Parser (pFixity, pOperator)
|
||||
import Ormolu.Fixity.Parser
|
||||
import Text.Megaparsec
|
||||
import Text.Megaparsec.Char
|
||||
|
||||
@ -59,8 +57,7 @@ pPackage :: Parser Package
|
||||
pPackage = do
|
||||
void (skipManyTill (pLineWithoutEol <* eol) (string "@package"))
|
||||
hspace1
|
||||
let isPackageNameConstituent x = x == '-' || isAlphaNum x
|
||||
packageName <- some (satisfy isPackageNameConstituent) <?> "package name"
|
||||
packageName <- pPackageName
|
||||
hspace
|
||||
void eol
|
||||
skipManyTill
|
||||
@ -68,7 +65,7 @@ pPackage = do
|
||||
(lookAhead (void (string "module ") <|> eof))
|
||||
modules <- many pModule
|
||||
eof
|
||||
return (Package (mkPackageName packageName) modules)
|
||||
return (Package packageName modules)
|
||||
|
||||
-- | Match a module declaration. It starts with the word @module@ followed
|
||||
-- by one or more spaces and a module identifier. A module contains
|
||||
@ -77,13 +74,11 @@ pModule :: Parser Module
|
||||
pModule = do
|
||||
void (string "module")
|
||||
hspace1
|
||||
let isModuleNameConstituent x =
|
||||
x == '.' || x == '_' || x == '\'' || isAlphaNum x
|
||||
moduleName <- some (satisfy isModuleNameConstituent) <?> "module name"
|
||||
moduleName <- pModuleName
|
||||
hspace
|
||||
void eol
|
||||
declarations <- mconcat <$> sepEndBy pDeclaration eol
|
||||
return (Module (ModuleName.fromString moduleName) declarations)
|
||||
return (Module moduleName declarations)
|
||||
|
||||
-- | Here we are interested in two kinds of declarations:
|
||||
--
|
||||
|
@ -1,2 +1,3 @@
|
||||
infixr 8 .=
|
||||
infixr 5 #, :>
|
||||
module Foo exports Control.Lens
|
||||
|
@ -24,6 +24,12 @@
|
||||
ormolu --check-idempotence --mode inplace -p base test-1-with-fixity-info-dotormolu.hs
|
||||
cp test-1-input.hs test-1-with-fixity-info-weird-overwrite.hs
|
||||
ormolu --check-idempotence --mode inplace -p base --fixity "infixr 5 $" test-1-with-fixity-info-weird-overwrite.hs
|
||||
cp test-2-input.hs test-2-no-extra-info.hs
|
||||
ormolu --check-idempotence --mode inplace --no-cabal -p base -p lens test-2-no-extra-info.hs
|
||||
cp test-2-input.hs test-2-reexports-manual.hs
|
||||
ormolu --check-idempotence --mode inplace --no-cabal -p base -p lens --reexport 'module Foo exports Control.Lens' test-2-reexports-manual.hs
|
||||
cp test-2-input.hs test-2-reexports-dotormolu.hs
|
||||
ormolu --check-idempotence --mode inplace -p base -p lens test-2-reexports-dotormolu.hs
|
||||
'';
|
||||
checkPhase = ''
|
||||
echo test-0-no-extra-info.hs
|
||||
@ -40,6 +46,12 @@
|
||||
diff --color=always test-1-with-fixity-info-expected.hs test-1-with-fixity-info-dotormolu.hs
|
||||
echo test-1-with-fixity-info-weird-overwrite.hs
|
||||
diff --color=always test-1-with-fixity-info-weird-overwrite-expected.hs test-1-with-fixity-info-weird-overwrite.hs
|
||||
echo test-2-no-extra-info.hs
|
||||
diff --color=always test-2-no-extra-info.hs test-2-no-extra-info-expected.hs
|
||||
echo test-2-reexports-manual.hs
|
||||
diff --color=always test-2-reexports-manual.hs test-2-with-reexports-expected.hs
|
||||
echo test-2-reexports-dotormolu.hs
|
||||
diff --color=always test-2-reexports-dotormolu.hs test-2-with-reexports-expected.hs
|
||||
'';
|
||||
installPhase = ''
|
||||
mkdir "$out"
|
||||
|
10
fixity-tests/test-2-input.hs
Normal file
10
fixity-tests/test-2-input.hs
Normal file
@ -0,0 +1,10 @@
|
||||
import Foo
|
||||
|
||||
foo = a
|
||||
& b .~ 2 & c .~ 3
|
||||
|
||||
wreq =
|
||||
let opts = defaults & auth ?~ awsAuth AWSv4 "key" "secret"
|
||||
& header "Accept" .~ ["application/json"]
|
||||
& header "Runscope-Bucket-Auth" .~ ["1example-1111-4yyyy-zzzz-xxxxxxxx"]
|
||||
in getWith opts
|
19
fixity-tests/test-2-no-extra-info-expected.hs
Normal file
19
fixity-tests/test-2-no-extra-info-expected.hs
Normal file
@ -0,0 +1,19 @@
|
||||
import Foo
|
||||
|
||||
foo =
|
||||
a
|
||||
& b
|
||||
.~ 2
|
||||
& c
|
||||
.~ 3
|
||||
|
||||
wreq =
|
||||
let opts =
|
||||
defaults
|
||||
& auth
|
||||
?~ awsAuth AWSv4 "key" "secret"
|
||||
& header "Accept"
|
||||
.~ ["application/json"]
|
||||
& header "Runscope-Bucket-Auth"
|
||||
.~ ["1example-1111-4yyyy-zzzz-xxxxxxxx"]
|
||||
in getWith opts
|
14
fixity-tests/test-2-with-reexports-expected.hs
Normal file
14
fixity-tests/test-2-with-reexports-expected.hs
Normal file
@ -0,0 +1,14 @@
|
||||
import Foo
|
||||
|
||||
foo =
|
||||
a
|
||||
& b .~ 2
|
||||
& c .~ 3
|
||||
|
||||
wreq =
|
||||
let opts =
|
||||
defaults
|
||||
& auth ?~ awsAuth AWSv4 "key" "secret"
|
||||
& header "Accept" .~ ["application/json"]
|
||||
& header "Runscope-Bucket-Auth" .~ ["1example-1111-4yyyy-zzzz-xxxxxxxx"]
|
||||
in getWith opts
|
@ -41,6 +41,7 @@
|
||||
compiler-nix-name = ghcVersion;
|
||||
modules = [{
|
||||
packages.ormolu.writeHieFiles = true;
|
||||
packages.extract-hackage-info.writeHieFiles = true;
|
||||
packages.ormolu.components.exes.ormolu.preBuild =
|
||||
lib.mkIf (self ? rev) ''export ORMOLU_REV=${self.rev}'';
|
||||
}];
|
||||
@ -66,7 +67,8 @@
|
||||
weeder --config ${./weeder.dhall} \
|
||||
--hie-directory ${hsPkgs.ormolu.components.library.hie} \
|
||||
--hie-directory ${hsPkgs.ormolu.components.exes.ormolu.hie} \
|
||||
--hie-directory ${hsPkgs.ormolu.components.tests.tests.hie}
|
||||
--hie-directory ${hsPkgs.ormolu.components.tests.tests.hie} \
|
||||
--hie-directory ${hsPkgs.extract-hackage-info.components.exes.extract-hackage-info.hie}
|
||||
'';
|
||||
});
|
||||
in
|
||||
|
@ -134,15 +134,16 @@ executable ormolu
|
||||
autogen-modules: Paths_ormolu
|
||||
default-language: GHC2021
|
||||
build-depends:
|
||||
Cabal-syntax >=3.10 && <3.11,
|
||||
base >=4.12 && <5.0,
|
||||
containers >=0.5 && <0.7,
|
||||
directory ^>=1.3,
|
||||
filepath >=1.2 && <1.5,
|
||||
ghc-lib-parser >=9.6 && <9.7,
|
||||
th-env >=0.1.1 && <0.2,
|
||||
optparse-applicative >=0.14 && <0.18,
|
||||
ormolu,
|
||||
text >=2.0 && <3.0
|
||||
text >=2.0 && <3.0,
|
||||
th-env >=0.1.1 && <0.2
|
||||
|
||||
if flag(dev)
|
||||
ghc-options:
|
||||
|
@ -24,9 +24,12 @@ module Ormolu
|
||||
CabalUtils.CabalInfo (..),
|
||||
CabalUtils.getCabalInfoForSourceFile,
|
||||
|
||||
-- * Fixity overrides
|
||||
-- * Fixity overrides and module re-exports
|
||||
FixityOverrides,
|
||||
getFixityOverridesForSourceFile,
|
||||
defaultFixityOverrides,
|
||||
ModuleReexports,
|
||||
defaultModuleReexports,
|
||||
parseDotOrmoluForSourceFile,
|
||||
|
||||
-- * Working with exceptions
|
||||
OrmoluException (..),
|
||||
@ -56,7 +59,7 @@ import Ormolu.Parser.Result
|
||||
import Ormolu.Printer
|
||||
import Ormolu.Utils (showOutputable)
|
||||
import Ormolu.Utils.Cabal qualified as CabalUtils
|
||||
import Ormolu.Utils.Fixity (getFixityOverridesForSourceFile)
|
||||
import Ormolu.Utils.Fixity (parseDotOrmoluForSourceFile)
|
||||
import Ormolu.Utils.IO
|
||||
import System.FilePath
|
||||
|
||||
@ -178,24 +181,37 @@ refineConfig ::
|
||||
Maybe CabalUtils.CabalInfo ->
|
||||
-- | Fixity overrides, if available
|
||||
Maybe FixityOverrides ->
|
||||
-- | Module re-exports, if available
|
||||
Maybe ModuleReexports ->
|
||||
-- | 'Config' to refine
|
||||
Config region ->
|
||||
-- | Refined 'Config'
|
||||
Config region
|
||||
refineConfig sourceType mcabalInfo mfixityOverrides rawConfig =
|
||||
refineConfig sourceType mcabalInfo mfixityOverrides mreexports rawConfig =
|
||||
rawConfig
|
||||
{ cfgDynOptions = cfgDynOptions rawConfig ++ dynOptsFromCabal,
|
||||
cfgFixityOverrides =
|
||||
FixityOverrides $
|
||||
Map.union
|
||||
(unFixityOverrides fixityOverrides)
|
||||
(unFixityOverrides (cfgFixityOverrides rawConfig)),
|
||||
Map.unions
|
||||
[ unFixityOverrides fixityOverrides,
|
||||
unFixityOverrides (cfgFixityOverrides rawConfig),
|
||||
unFixityOverrides defaultFixityOverrides
|
||||
],
|
||||
cfgModuleReexports =
|
||||
ModuleReexports $
|
||||
Map.unionsWith
|
||||
(<>)
|
||||
[ unModuleReexports reexports,
|
||||
unModuleReexports (cfgModuleReexports rawConfig),
|
||||
unModuleReexports defaultModuleReexports
|
||||
],
|
||||
cfgDependencies =
|
||||
Set.union (cfgDependencies rawConfig) depsFromCabal,
|
||||
cfgSourceType = sourceType
|
||||
}
|
||||
where
|
||||
fixityOverrides = fromMaybe (FixityOverrides Map.empty) mfixityOverrides
|
||||
fixityOverrides = fromMaybe defaultFixityOverrides mfixityOverrides
|
||||
reexports = fromMaybe defaultModuleReexports mreexports
|
||||
(dynOptsFromCabal, depsFromCabal) =
|
||||
case mcabalInfo of
|
||||
Nothing ->
|
||||
|
@ -14,13 +14,12 @@ module Ormolu.Config
|
||||
)
|
||||
where
|
||||
|
||||
import Data.Map.Strict qualified as Map
|
||||
import Data.Set (Set)
|
||||
import Data.Set qualified as Set
|
||||
import Distribution.Types.PackageName (PackageName)
|
||||
import GHC.Generics (Generic)
|
||||
import GHC.Types.SrcLoc qualified as GHC
|
||||
import Ormolu.Fixity (FixityOverrides (..))
|
||||
import Ormolu.Fixity
|
||||
import Ormolu.Terminal (ColorMode (..))
|
||||
|
||||
-- | Type of sources that can be formatted by Ormolu.
|
||||
@ -36,7 +35,9 @@ data Config region = Config
|
||||
{ -- | Dynamic options to pass to GHC parser
|
||||
cfgDynOptions :: ![DynOption],
|
||||
-- | Fixity overrides
|
||||
cfgFixityOverrides :: FixityOverrides,
|
||||
cfgFixityOverrides :: !FixityOverrides,
|
||||
-- | Module reexports to take into account when doing fixity resolution
|
||||
cfgModuleReexports :: !ModuleReexports,
|
||||
-- | Known dependencies, if any
|
||||
cfgDependencies :: !(Set PackageName),
|
||||
-- | Do formatting faster but without automatic detection of defects
|
||||
@ -78,7 +79,8 @@ defaultConfig :: Config RegionIndices
|
||||
defaultConfig =
|
||||
Config
|
||||
{ cfgDynOptions = [],
|
||||
cfgFixityOverrides = FixityOverrides Map.empty,
|
||||
cfgFixityOverrides = defaultFixityOverrides,
|
||||
cfgModuleReexports = defaultModuleReexports,
|
||||
cfgDependencies = Set.empty,
|
||||
cfgUnsafe = False,
|
||||
cfgDebug = False,
|
||||
|
@ -16,6 +16,9 @@ module Ormolu.Fixity
|
||||
FixityApproximation (..),
|
||||
defaultFixityApproximation,
|
||||
FixityOverrides (..),
|
||||
defaultFixityOverrides,
|
||||
ModuleReexports (..),
|
||||
defaultModuleReexports,
|
||||
PackageFixityMap (..),
|
||||
ModuleFixityMap (..),
|
||||
inferFixity,
|
||||
@ -154,7 +157,7 @@ moduleFixityMap (PackageFixityMap m) imports =
|
||||
Nothing -> True
|
||||
Just p -> p == packageName
|
||||
moduleMatches =
|
||||
fimportModuleName == moduleName
|
||||
fimportModule == moduleName
|
||||
opMatches = case fimportList of
|
||||
Nothing -> True
|
||||
Just (Exactly, xs) -> opName `elem` xs
|
||||
|
@ -6,10 +6,13 @@
|
||||
module Ormolu.Fixity.Imports
|
||||
( FixityImport (..),
|
||||
extractFixityImports,
|
||||
applyModuleReexports,
|
||||
)
|
||||
where
|
||||
|
||||
import Data.Bifunctor (second)
|
||||
import Data.List.NonEmpty qualified as NE
|
||||
import Data.Map.Strict qualified as Map
|
||||
import Distribution.ModuleName (ModuleName)
|
||||
import Distribution.Types.PackageName
|
||||
import GHC.Data.FastString qualified as GHC
|
||||
@ -24,7 +27,7 @@ import Ormolu.Utils (ghcModuleNameToCabal)
|
||||
-- | Simplified info about an import.
|
||||
data FixityImport = FixityImport
|
||||
{ fimportPackage :: !(Maybe PackageName),
|
||||
fimportModuleName :: !ModuleName,
|
||||
fimportModule :: !ModuleName,
|
||||
fimportQualified :: !FixityQualification,
|
||||
fimportList :: !(Maybe (ImportListInterpretation, [OpName]))
|
||||
}
|
||||
@ -43,7 +46,7 @@ extractFixityImport ImportDecl {..} =
|
||||
NoRawPkgQual -> Nothing
|
||||
RawPkgQual strLiteral ->
|
||||
Just . mkPackageName . GHC.unpackFS . sl_fs $ strLiteral,
|
||||
fimportModuleName = ideclName',
|
||||
fimportModule = ideclName',
|
||||
fimportQualified = case (ideclQualified, ideclAs') of
|
||||
(QualifiedPre, Nothing) ->
|
||||
OnlyQualified ideclName'
|
||||
@ -71,3 +74,18 @@ ieToOccNames = \case
|
||||
IEThingAll _ (L _ x) -> [occName x] -- TODO not quite correct, but how to do better?
|
||||
IEThingWith _ (L _ x) _ xs -> occName x : fmap (occName . unLoc) xs
|
||||
_ -> []
|
||||
|
||||
-- | Apply given module re-exports.
|
||||
applyModuleReexports :: ModuleReexports -> [FixityImport] -> [FixityImport]
|
||||
applyModuleReexports (ModuleReexports reexports) imports = imports >>= expand
|
||||
where
|
||||
expand i = do
|
||||
case Map.lookup (fimportModule i) reexports of
|
||||
Nothing -> pure i
|
||||
Just exports ->
|
||||
let exportToImport mmodule =
|
||||
i
|
||||
{ fimportPackage = Nothing,
|
||||
fimportModule = mmodule
|
||||
}
|
||||
in NE.toList exports >>= expand . exportToImport
|
||||
|
@ -1,5 +1,6 @@
|
||||
{-# LANGUAGE DeriveAnyClass #-}
|
||||
{-# LANGUAGE DerivingStrategies #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE PatternSynonyms #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE ViewPatterns #-}
|
||||
@ -17,6 +18,9 @@ module Ormolu.Fixity.Internal
|
||||
defaultFixityApproximation,
|
||||
HackageInfo (..),
|
||||
FixityOverrides (..),
|
||||
defaultFixityOverrides,
|
||||
ModuleReexports (..),
|
||||
defaultModuleReexports,
|
||||
PackageFixityMap (..),
|
||||
ModuleFixityMap (..),
|
||||
FixityProvenance (..),
|
||||
@ -29,7 +33,7 @@ import Control.DeepSeq (NFData)
|
||||
import Data.Binary (Binary)
|
||||
import Data.ByteString.Short (ShortByteString)
|
||||
import Data.ByteString.Short qualified as SBS
|
||||
import Data.List.NonEmpty (NonEmpty)
|
||||
import Data.List.NonEmpty (NonEmpty (..))
|
||||
import Data.List.NonEmpty qualified as NE
|
||||
import Data.Map.Strict (Map)
|
||||
import Data.Map.Strict qualified as Map
|
||||
@ -156,6 +160,63 @@ newtype FixityOverrides = FixityOverrides
|
||||
}
|
||||
deriving stock (Eq, Show)
|
||||
|
||||
-- | Fixity overrides to use by default.
|
||||
defaultFixityOverrides :: FixityOverrides
|
||||
defaultFixityOverrides = FixityOverrides Map.empty
|
||||
|
||||
-- | Module re-exports
|
||||
newtype ModuleReexports = ModuleReexports
|
||||
{ unModuleReexports :: Map ModuleName (NonEmpty ModuleName)
|
||||
}
|
||||
deriving stock (Eq, Show)
|
||||
|
||||
-- | Module re-exports to apply by default.
|
||||
defaultModuleReexports :: ModuleReexports
|
||||
defaultModuleReexports =
|
||||
ModuleReexports . Map.fromList $
|
||||
[ ( "Control.Lens",
|
||||
NE.fromList
|
||||
[ "Control.Lens.At",
|
||||
"Control.Lens.Cons",
|
||||
"Control.Lens.Each",
|
||||
"Control.Lens.Empty",
|
||||
"Control.Lens.Equality",
|
||||
"Control.Lens.Fold",
|
||||
"Control.Lens.Getter",
|
||||
"Control.Lens.Indexed",
|
||||
"Control.Lens.Iso",
|
||||
"Control.Lens.Lens",
|
||||
"Control.Lens.Level",
|
||||
"Control.Lens.Plated",
|
||||
"Control.Lens.Prism",
|
||||
"Control.Lens.Reified",
|
||||
"Control.Lens.Review",
|
||||
"Control.Lens.Setter",
|
||||
"Control.Lens.TH",
|
||||
"Control.Lens.Traversal",
|
||||
"Control.Lens.Tuple",
|
||||
"Control.Lens.Type",
|
||||
"Control.Lens.Wrapped",
|
||||
"Control.Lens.Zoom"
|
||||
]
|
||||
),
|
||||
( "Servant",
|
||||
NE.fromList
|
||||
[ "Servant.API"
|
||||
]
|
||||
),
|
||||
( "Optics",
|
||||
NE.fromList
|
||||
[ "Optics.Fold",
|
||||
"Optics.Operators",
|
||||
"Optics.IxAffineFold",
|
||||
"Optics.IxFold",
|
||||
"Optics.IxTraversal",
|
||||
"Optics.Traversal"
|
||||
]
|
||||
)
|
||||
]
|
||||
|
||||
-- | Fixity information that is specific to a package being formatted. It
|
||||
-- requires module-specific imports in order to be usable.
|
||||
newtype PackageFixityMap
|
||||
|
@ -3,21 +3,41 @@
|
||||
|
||||
-- | Parser for fixity maps.
|
||||
module Ormolu.Fixity.Parser
|
||||
( parseFixityOverrides,
|
||||
( parseDotOrmolu,
|
||||
parseFixityDeclaration,
|
||||
parseModuleReexportDeclaration,
|
||||
|
||||
-- * Raw parsers
|
||||
pFixity,
|
||||
pOperator,
|
||||
pModuleName,
|
||||
pPackageName,
|
||||
|
||||
-- * Internal
|
||||
isIdentifierFirstChar,
|
||||
isIdentifierConstituent,
|
||||
isOperatorConstituent,
|
||||
isPackageNameConstituent,
|
||||
isModuleSegmentFirstChar,
|
||||
isModuleSegmentConstituent,
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Monad (when)
|
||||
import Control.Monad (void, when)
|
||||
import Data.Bifunctor (bimap)
|
||||
import Data.Char (isAlphaNum, isUpper)
|
||||
import Data.Char qualified as Char
|
||||
import Data.Either (partitionEithers)
|
||||
import Data.List (intercalate)
|
||||
import Data.List.NonEmpty (NonEmpty (..))
|
||||
import Data.List.NonEmpty qualified as NE
|
||||
import Data.Map.Strict qualified as Map
|
||||
import Data.Text (Text)
|
||||
import Data.Text qualified as T
|
||||
import Data.Void (Void)
|
||||
import Distribution.ModuleName (ModuleName)
|
||||
import Distribution.ModuleName qualified as ModuleName
|
||||
import Distribution.Types.PackageName (PackageName, mkPackageName)
|
||||
import Ormolu.Fixity
|
||||
import Text.Megaparsec
|
||||
import Text.Megaparsec.Char
|
||||
@ -26,28 +46,47 @@ import Text.Megaparsec.Char.Lexer qualified as L
|
||||
type Parser = Parsec Void Text
|
||||
|
||||
-- | Parse textual representation of 'FixityOverrides'.
|
||||
parseFixityOverrides ::
|
||||
parseDotOrmolu ::
|
||||
-- | Location of the file we are parsing (only for parse errors)
|
||||
FilePath ->
|
||||
-- | File contents to parse
|
||||
Text ->
|
||||
-- | Parse result
|
||||
Either (ParseErrorBundle Text Void) FixityOverrides
|
||||
parseFixityOverrides = runParser pFixityOverrides
|
||||
Either (ParseErrorBundle Text Void) (FixityOverrides, ModuleReexports)
|
||||
parseDotOrmolu = runParser pDotOrmolu
|
||||
|
||||
-- | Parse a single self-contained fixity declaration.
|
||||
parseFixityDeclaration ::
|
||||
-- | Expression to parse
|
||||
-- | Text to parse
|
||||
Text ->
|
||||
-- | Parse result
|
||||
Either (ParseErrorBundle Text Void) [(OpName, FixityInfo)]
|
||||
parseFixityDeclaration = runParser (pFixity <* eof) ""
|
||||
|
||||
pFixityOverrides :: Parser FixityOverrides
|
||||
pFixityOverrides =
|
||||
FixityOverrides . Map.fromList . mconcat
|
||||
<$> many (pFixity <* eol <* hidden space)
|
||||
-- | Parse a single self-contained module re-export declaration.
|
||||
parseModuleReexportDeclaration ::
|
||||
-- | Text to parse
|
||||
Text ->
|
||||
-- | Parse result
|
||||
Either
|
||||
(ParseErrorBundle Text Void)
|
||||
(ModuleName, NonEmpty ModuleName)
|
||||
parseModuleReexportDeclaration = runParser (pModuleReexport <* eof) ""
|
||||
|
||||
pDotOrmolu :: Parser (FixityOverrides, ModuleReexports)
|
||||
pDotOrmolu =
|
||||
bimap
|
||||
(FixityOverrides . Map.fromList . mconcat)
|
||||
(ModuleReexports . Map.map NE.sort . Map.fromListWith (<>))
|
||||
. partitionEithers
|
||||
<$> many configLine
|
||||
<* eof
|
||||
where
|
||||
configLine = do
|
||||
x <- eitherP pFixity pModuleReexport
|
||||
void eol
|
||||
hidden space
|
||||
return x
|
||||
|
||||
-- | Parse a single fixity declaration, such as
|
||||
--
|
||||
@ -85,8 +124,60 @@ pOperator = OpName <$> (tickedOperator <|> normalOperator)
|
||||
haskellIdentifier =
|
||||
T.cons
|
||||
<$> letterChar
|
||||
<*> takeWhileP Nothing (\x -> Char.isAlphaNum x || x == '_' || x == '\'')
|
||||
<*> takeWhileP Nothing isIdentifierConstituent
|
||||
normalOperator =
|
||||
takeWhile1P (Just "operator character") $ \x ->
|
||||
(Char.isSymbol x || Char.isPunctuation x)
|
||||
&& (x /= ',' && x /= '`' && x /= '(' && x /= ')')
|
||||
takeWhile1P (Just "operator character") isOperatorConstituent
|
||||
|
||||
pModuleReexport :: Parser (ModuleName, NonEmpty ModuleName)
|
||||
pModuleReexport = do
|
||||
void (string "module")
|
||||
hidden hspace1
|
||||
exportingModule <- pModuleName
|
||||
hidden hspace1
|
||||
void (string "exports")
|
||||
hidden hspace1
|
||||
exportedModule <- pModuleName
|
||||
hidden hspace
|
||||
return (exportingModule, NE.singleton exportedModule)
|
||||
|
||||
pModuleName :: Parser ModuleName
|
||||
pModuleName =
|
||||
ModuleName.fromString . intercalate "."
|
||||
<$> sepBy1 pModuleSegment (char '.')
|
||||
<?> "module name"
|
||||
where
|
||||
pModuleSegment = do
|
||||
x <- satisfy isModuleSegmentFirstChar <?> "capital letter"
|
||||
xs <-
|
||||
many
|
||||
( satisfy isModuleSegmentConstituent
|
||||
<?> "module segment continuation"
|
||||
)
|
||||
return (x : xs)
|
||||
|
||||
pPackageName :: Parser PackageName
|
||||
pPackageName =
|
||||
mkPackageName <$> some (satisfy isPackageNameConstituent) <?> "package name"
|
||||
|
||||
-- Internal predicates (exposed for testing)
|
||||
|
||||
isIdentifierFirstChar :: Char -> Bool
|
||||
isIdentifierFirstChar = Char.isLetter
|
||||
|
||||
isIdentifierConstituent :: Char -> Bool
|
||||
isIdentifierConstituent x = Char.isAlphaNum x || x == '_' || x == '\''
|
||||
|
||||
isOperatorConstituent :: Char -> Bool
|
||||
isOperatorConstituent x =
|
||||
(Char.isSymbol x || Char.isPunctuation x)
|
||||
&& (x /= ',' && x /= '`' && x /= '(' && x /= ')')
|
||||
|
||||
isPackageNameConstituent :: Char -> Bool
|
||||
isPackageNameConstituent x = x == '-' || isAlphaNum x
|
||||
|
||||
isModuleSegmentFirstChar :: Char -> Bool
|
||||
isModuleSegmentFirstChar x = isAlphaNum x && isUpper x
|
||||
|
||||
isModuleSegmentConstituent :: Char -> Bool
|
||||
isModuleSegmentConstituent x =
|
||||
x == '_' || x == '\'' || isAlphaNum x
|
||||
|
@ -3,42 +3,69 @@
|
||||
|
||||
-- | Printer for fixity overrides.
|
||||
module Ormolu.Fixity.Printer
|
||||
( printFixityOverrides,
|
||||
( printDotOrmolu,
|
||||
)
|
||||
where
|
||||
|
||||
import Data.Char qualified as Char
|
||||
import Data.List (intercalate)
|
||||
import Data.List.NonEmpty (NonEmpty)
|
||||
import Data.Map.Strict qualified as Map
|
||||
import Data.Semigroup (sconcat)
|
||||
import Data.Text (Text)
|
||||
import Data.Text qualified as T
|
||||
import Data.Text.Lazy qualified as TL
|
||||
import Data.Text.Lazy.Builder (Builder)
|
||||
import Data.Text.Lazy.Builder qualified as B
|
||||
import Data.Text.Lazy.Builder.Int qualified as B
|
||||
import Distribution.ModuleName (ModuleName)
|
||||
import Distribution.ModuleName qualified as ModuleName
|
||||
import Ormolu.Fixity
|
||||
|
||||
-- | Print out a textual representation of 'FixityOverrides'.
|
||||
printFixityOverrides :: FixityOverrides -> Text
|
||||
printFixityOverrides (FixityOverrides m) =
|
||||
TL.toStrict
|
||||
. B.toLazyText
|
||||
. mconcat
|
||||
. fmap renderOne
|
||||
$ Map.toList m
|
||||
-- | Print out a textual representation of an @.ormolu@ file.
|
||||
printDotOrmolu ::
|
||||
FixityOverrides ->
|
||||
ModuleReexports ->
|
||||
Text
|
||||
printDotOrmolu
|
||||
(FixityOverrides fixityOverrides)
|
||||
(ModuleReexports moduleReexports) =
|
||||
TL.toStrict . B.toLazyText $
|
||||
(mconcat . fmap renderSingleFixityOverride . Map.toList) fixityOverrides
|
||||
<> (mconcat . fmap renderSingleModuleReexport . Map.toList) moduleReexports
|
||||
|
||||
renderSingleFixityOverride :: (OpName, FixityInfo) -> Builder
|
||||
renderSingleFixityOverride (OpName operator, FixityInfo {..}) =
|
||||
mconcat
|
||||
[ case fiDirection of
|
||||
InfixL -> "infixl"
|
||||
InfixR -> "infixr"
|
||||
InfixN -> "infix",
|
||||
" ",
|
||||
B.decimal fiPrecedence,
|
||||
" ",
|
||||
if isTickedOperator operator
|
||||
then "`" <> B.fromText operator <> "`"
|
||||
else B.fromText operator,
|
||||
"\n"
|
||||
]
|
||||
where
|
||||
renderOne :: (OpName, FixityInfo) -> Builder
|
||||
renderOne (OpName operator, FixityInfo {..}) =
|
||||
isTickedOperator = maybe True (Char.isLetter . fst) . T.uncons
|
||||
|
||||
renderSingleModuleReexport ::
|
||||
(ModuleName, NonEmpty ModuleName) ->
|
||||
Builder
|
||||
renderSingleModuleReexport (exportingModule, exports) =
|
||||
sconcat (renderSingle <$> exports)
|
||||
where
|
||||
renderSingle exportedModule =
|
||||
mconcat
|
||||
[ case fiDirection of
|
||||
InfixL -> "infixl"
|
||||
InfixR -> "infixr"
|
||||
InfixN -> "infix",
|
||||
" ",
|
||||
B.decimal fiPrecedence,
|
||||
" ",
|
||||
if isTickedOperator operator
|
||||
then "`" <> B.fromText operator <> "`"
|
||||
else B.fromText operator,
|
||||
[ "module ",
|
||||
renderModuleName exportingModule,
|
||||
" exports ",
|
||||
renderModuleName exportedModule,
|
||||
"\n"
|
||||
]
|
||||
isTickedOperator = maybe True (Char.isLetter . fst) . T.uncons
|
||||
|
||||
renderModuleName :: ModuleName -> Builder
|
||||
renderModuleName = B.fromString . intercalate "." . ModuleName.components
|
||||
|
@ -49,7 +49,7 @@ import GHC.Utils.Panic qualified as GHC
|
||||
import Ormolu.Config
|
||||
import Ormolu.Exception
|
||||
import Ormolu.Fixity hiding (packageFixityMap)
|
||||
import Ormolu.Fixity.Imports (extractFixityImports)
|
||||
import Ormolu.Fixity.Imports (applyModuleReexports, extractFixityImports)
|
||||
import Ormolu.Imports (normalizeImports)
|
||||
import Ormolu.Parser.CommentStream
|
||||
import Ormolu.Parser.Result
|
||||
@ -94,8 +94,10 @@ parseModule config@Config {..} packageFixityMap path rawInput = liftIO $ do
|
||||
implicitPrelude = EnumSet.member ImplicitPrelude (GHC.extensionFlags dynFlags)
|
||||
fixityImports <-
|
||||
parseImports dynFlags implicitPrelude path rawInputStringBuffer >>= \case
|
||||
Right res -> pure (extractFixityImports res)
|
||||
Left err -> throwIO (OrmoluParsingFailed beginningLoc err)
|
||||
Right res ->
|
||||
pure (applyModuleReexports cfgModuleReexports (extractFixityImports res))
|
||||
Left err ->
|
||||
throwIO (OrmoluParsingFailed beginningLoc err)
|
||||
let modFixityMap =
|
||||
applyFixityOverrides
|
||||
cfgFixityOverrides
|
||||
|
@ -1,8 +1,9 @@
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
|
||||
module Ormolu.Utils.Fixity
|
||||
( getFixityOverridesForSourceFile,
|
||||
( parseDotOrmoluForSourceFile,
|
||||
parseFixityDeclarationStr,
|
||||
parseModuleReexportDeclarationStr,
|
||||
)
|
||||
where
|
||||
|
||||
@ -10,9 +11,11 @@ import Control.Exception (throwIO)
|
||||
import Control.Monad.IO.Class
|
||||
import Data.Bifunctor (first)
|
||||
import Data.IORef
|
||||
import Data.List.NonEmpty (NonEmpty)
|
||||
import Data.Map.Strict (Map)
|
||||
import Data.Map.Strict qualified as Map
|
||||
import Data.Text qualified as T
|
||||
import Distribution.ModuleName (ModuleName)
|
||||
import Ormolu.Exception
|
||||
import Ormolu.Fixity
|
||||
import Ormolu.Fixity.Parser
|
||||
@ -24,19 +27,20 @@ import System.IO.Unsafe (unsafePerformIO)
|
||||
import Text.Megaparsec (errorBundlePretty)
|
||||
|
||||
-- | Cache ref that stores fixity overrides per cabal file.
|
||||
cacheRef :: IORef (Map FilePath FixityOverrides)
|
||||
cacheRef :: IORef (Map FilePath (FixityOverrides, ModuleReexports))
|
||||
cacheRef = unsafePerformIO (newIORef Map.empty)
|
||||
{-# NOINLINE cacheRef #-}
|
||||
|
||||
-- | Attempt to locate and parse an @.ormolu@ file. If it does not exist,
|
||||
-- empty fixity map is returned. This function maintains a cache of fixity
|
||||
-- overrides where cabal file paths act as keys.
|
||||
getFixityOverridesForSourceFile ::
|
||||
-- default fixity map and module reexports are returned. This function
|
||||
-- maintains a cache of fixity overrides and module re-exports where cabal
|
||||
-- file paths act as keys.
|
||||
parseDotOrmoluForSourceFile ::
|
||||
(MonadIO m) =>
|
||||
-- | 'CabalInfo' already obtained for this source file
|
||||
CabalInfo ->
|
||||
m FixityOverrides
|
||||
getFixityOverridesForSourceFile CabalInfo {..} = liftIO $ do
|
||||
m (FixityOverrides, ModuleReexports)
|
||||
parseDotOrmoluForSourceFile CabalInfo {..} = liftIO $ do
|
||||
cache <- readIORef cacheRef
|
||||
case Map.lookup ciCabalFilePath cache of
|
||||
Nothing -> do
|
||||
@ -46,13 +50,13 @@ getFixityOverridesForSourceFile CabalInfo {..} = liftIO $ do
|
||||
then do
|
||||
dotOrmoluRelative <- makeRelativeToCurrentDirectory dotOrmolu
|
||||
contents <- readFileUtf8 dotOrmolu
|
||||
case parseFixityOverrides dotOrmoluRelative contents of
|
||||
case parseDotOrmolu dotOrmoluRelative contents of
|
||||
Left errorBundle ->
|
||||
throwIO (OrmoluFixityOverridesParseError errorBundle)
|
||||
Right x -> do
|
||||
modifyIORef' cacheRef (Map.insert ciCabalFilePath x)
|
||||
return x
|
||||
else return (FixityOverrides Map.empty)
|
||||
else return (defaultFixityOverrides, defaultModuleReexports)
|
||||
Just x -> return x
|
||||
|
||||
-- | A wrapper around 'parseFixityDeclaration' for parsing individual fixity
|
||||
@ -64,3 +68,13 @@ parseFixityDeclarationStr ::
|
||||
Either String [(OpName, FixityInfo)]
|
||||
parseFixityDeclarationStr =
|
||||
first errorBundlePretty . parseFixityDeclaration . T.pack
|
||||
|
||||
-- | A wrapper around 'parseModuleReexportDeclaration' for parsing
|
||||
-- a individual module reexport.
|
||||
parseModuleReexportDeclarationStr ::
|
||||
-- | Input to parse
|
||||
String ->
|
||||
-- | Parse result
|
||||
Either String (ModuleName, NonEmpty ModuleName)
|
||||
parseModuleReexportDeclarationStr =
|
||||
first errorBundlePretty . parseModuleReexportDeclaration . T.pack
|
||||
|
@ -2,6 +2,7 @@
|
||||
|
||||
module Ormolu.Fixity.ParserSpec (spec) where
|
||||
|
||||
import Data.List.NonEmpty (NonEmpty (..))
|
||||
import Data.Map.Strict qualified as Map
|
||||
import Data.Text (Text)
|
||||
import Data.Text qualified as T
|
||||
@ -13,6 +14,96 @@ import Text.Megaparsec.Error (ErrorFancy (..))
|
||||
|
||||
spec :: Spec
|
||||
spec = do
|
||||
describe "parseDotOrmolu" $ do
|
||||
it "parses the empty input without choking" $
|
||||
parseDotOrmolu "" ""
|
||||
`shouldParse` (FixityOverrides Map.empty, ModuleReexports Map.empty)
|
||||
it "parses a collection of fixity declarations" $
|
||||
-- The example is taken from base.
|
||||
parseDotOrmolu
|
||||
""
|
||||
( T.unlines
|
||||
[ "infixr 9 .",
|
||||
"infixr 5 ++",
|
||||
"infixl 4 <$",
|
||||
"infixl 1 >>, >>=",
|
||||
"infixr 1 =<<",
|
||||
"infixr 0 $, $!",
|
||||
"infixl 4 <*>, <*, *>, <**>"
|
||||
]
|
||||
)
|
||||
`shouldParse` ( exampleFixityOverrides,
|
||||
ModuleReexports Map.empty
|
||||
)
|
||||
it "combines conflicting fixity declarations correctly" $
|
||||
parseDotOrmolu
|
||||
""
|
||||
( T.unlines
|
||||
[ "infixr 9 ., ^",
|
||||
"infixr 7 ., $",
|
||||
"infixr 9 ^ ",
|
||||
"infixl 7 $"
|
||||
]
|
||||
)
|
||||
`shouldParse` ( FixityOverrides
|
||||
( Map.fromList
|
||||
[ ("$", FixityInfo InfixL 7),
|
||||
(".", FixityInfo InfixR 7),
|
||||
("^", FixityInfo InfixR 9)
|
||||
]
|
||||
),
|
||||
ModuleReexports Map.empty
|
||||
)
|
||||
it "handles CRLF line endings correctly" $
|
||||
parseDotOrmolu ""
|
||||
`shouldSucceedOn` unlinesCrlf
|
||||
[ "infixr 9 .",
|
||||
"infixr 5 ++"
|
||||
]
|
||||
it "fails with correct parse error (keyword wrong second line)" $
|
||||
parseDotOrmolu "" "infixr 5 .\nfoobar 5 $"
|
||||
`shouldFailWith` err
|
||||
11
|
||||
( mconcat
|
||||
[ utok 'f',
|
||||
etoks "infix",
|
||||
etoks "infixl",
|
||||
etoks "infixr",
|
||||
etoks "module",
|
||||
eeof
|
||||
]
|
||||
)
|
||||
it "parses module re-exports and combines them correctly" $
|
||||
parseDotOrmolu
|
||||
""
|
||||
( T.unlines
|
||||
[ "module Control.Lens exports Control.Lens.Lens",
|
||||
"module Control.Lens exports Control.Lens.At",
|
||||
"module Text.Megaparsec exports Control.Monad.Combinators"
|
||||
]
|
||||
)
|
||||
`shouldParse` (FixityOverrides Map.empty, exampleModuleReexports)
|
||||
it "parses fixity declarations + module re-export declarations with blanks" $
|
||||
parseDotOrmolu
|
||||
""
|
||||
( T.unlines
|
||||
[ "module Control.Lens exports Control.Lens.Lens",
|
||||
"",
|
||||
"infixr 5 ++",
|
||||
"infixl 4 <$",
|
||||
"",
|
||||
"",
|
||||
"module Control.Lens exports Control.Lens.At",
|
||||
"infixr 9 .",
|
||||
"module Text.Megaparsec exports Control.Monad.Combinators",
|
||||
"infixl 1 >>, >>=",
|
||||
"infixr 1 =<<",
|
||||
"",
|
||||
"infixr 0 $, $!",
|
||||
"infixl 4 <*>, <*, *>, <**>"
|
||||
]
|
||||
)
|
||||
`shouldParse` (exampleFixityOverrides, exampleModuleReexports)
|
||||
describe "parseFixtiyDeclaration" $ do
|
||||
it "parses a simple infixr declaration" $
|
||||
parseFixityDeclaration "infixr 5 $"
|
||||
@ -75,75 +166,69 @@ spec = do
|
||||
`shouldFailWith` errFancy
|
||||
7
|
||||
(fancy (ErrorFail "precedence should not be greater than 9"))
|
||||
describe "parseFixityOverrides" $ do
|
||||
it "parses the empty input without choking" $
|
||||
parseFixityOverrides "" ""
|
||||
`shouldParse` FixityOverrides Map.empty
|
||||
it "parses a collection of declarations" $
|
||||
-- The example is taken from base.
|
||||
parseFixityOverrides
|
||||
""
|
||||
( T.unlines
|
||||
[ "infixr 9 .",
|
||||
"infixr 5 ++",
|
||||
"infixl 4 <$",
|
||||
"infixl 1 >>, >>=",
|
||||
"infixr 1 =<<",
|
||||
"infixr 0 $, $!",
|
||||
"infixl 4 <*>, <*, *>, <**>"
|
||||
]
|
||||
)
|
||||
`shouldParse` FixityOverrides
|
||||
( Map.fromList
|
||||
[ ("$", FixityInfo InfixR 0),
|
||||
("$!", FixityInfo InfixR 0),
|
||||
("*>", FixityInfo InfixL 4),
|
||||
("++", FixityInfo InfixR 5),
|
||||
(".", FixityInfo InfixR 9),
|
||||
("<$", FixityInfo InfixL 4),
|
||||
("<*", FixityInfo InfixL 4),
|
||||
("<**>", FixityInfo InfixL 4),
|
||||
("<*>", FixityInfo InfixL 4),
|
||||
("=<<", FixityInfo InfixR 1),
|
||||
(">>", FixityInfo InfixL 1),
|
||||
(">>=", FixityInfo InfixL 1)
|
||||
]
|
||||
)
|
||||
it "combines conflicting declarations correctly" $
|
||||
parseFixityOverrides
|
||||
""
|
||||
( T.unlines
|
||||
[ "infixr 9 ., ^",
|
||||
"infixr 7 ., $",
|
||||
"infixr 9 ^ ",
|
||||
"infixl 7 $"
|
||||
]
|
||||
)
|
||||
`shouldParse` FixityOverrides
|
||||
( Map.fromList
|
||||
[ ("$", FixityInfo InfixL 7),
|
||||
(".", FixityInfo InfixR 7),
|
||||
("^", FixityInfo InfixR 9)
|
||||
]
|
||||
)
|
||||
it "handles CRLF line endings correctly" $
|
||||
parseFixityOverrides ""
|
||||
`shouldSucceedOn` unlinesCrlf
|
||||
[ "infixr 9 .",
|
||||
"infixr 5 ++"
|
||||
]
|
||||
it "fails with correct parse error (keyword wrong second line)" $
|
||||
parseFixityOverrides "" "infixr 5 .\nfoobar 5 $"
|
||||
describe "parseModuleReexportDeclaration" $ do
|
||||
it "parses a re-export declaration" $
|
||||
parseModuleReexportDeclaration "module Control.Lens exports Control.Lens.Lens"
|
||||
`shouldParse` ( "Control.Lens",
|
||||
"Control.Lens.Lens" :| []
|
||||
)
|
||||
it "fails with correct parse error (keyword wrong)" $
|
||||
parseModuleReexportDeclaration "foo Control.Lens exports Control.Lens.Lens"
|
||||
`shouldFailWith` err
|
||||
11
|
||||
0
|
||||
( mconcat
|
||||
[ utok 'f',
|
||||
etoks "infix",
|
||||
etoks "infixl",
|
||||
etoks "infixr",
|
||||
eeof
|
||||
[ utoks "foo Co",
|
||||
etoks "module"
|
||||
]
|
||||
)
|
||||
it "fails with correct parse error (module syntax)" $
|
||||
parseModuleReexportDeclaration "module control.Lens exports Control.Lens.Lens"
|
||||
`shouldFailWith` err
|
||||
7
|
||||
( mconcat
|
||||
[ utok 'c',
|
||||
elabel "module name"
|
||||
]
|
||||
)
|
||||
it "fails with correct parse error (typo: export intead exports)" $
|
||||
parseModuleReexportDeclaration "module Control.Lens export Control.Lens.Lens"
|
||||
`shouldFailWith` err
|
||||
20
|
||||
( mconcat
|
||||
[ utoks "export ",
|
||||
etoks "exports"
|
||||
]
|
||||
)
|
||||
|
||||
exampleFixityOverrides :: FixityOverrides
|
||||
exampleFixityOverrides =
|
||||
FixityOverrides
|
||||
( Map.fromList
|
||||
[ ("$", FixityInfo InfixR 0),
|
||||
("$!", FixityInfo InfixR 0),
|
||||
("*>", FixityInfo InfixL 4),
|
||||
("++", FixityInfo InfixR 5),
|
||||
(".", FixityInfo InfixR 9),
|
||||
("<$", FixityInfo InfixL 4),
|
||||
("<*", FixityInfo InfixL 4),
|
||||
("<**>", FixityInfo InfixL 4),
|
||||
("<*>", FixityInfo InfixL 4),
|
||||
("=<<", FixityInfo InfixR 1),
|
||||
(">>", FixityInfo InfixL 1),
|
||||
(">>=", FixityInfo InfixL 1)
|
||||
]
|
||||
)
|
||||
|
||||
exampleModuleReexports :: ModuleReexports
|
||||
exampleModuleReexports =
|
||||
ModuleReexports . Map.fromList $
|
||||
[ ( "Control.Lens",
|
||||
"Control.Lens.At" :| ["Control.Lens.Lens"]
|
||||
),
|
||||
( "Text.Megaparsec",
|
||||
"Control.Monad.Combinators" :| []
|
||||
)
|
||||
]
|
||||
|
||||
unlinesCrlf :: [Text] -> Text
|
||||
unlinesCrlf = T.concat . fmap (<> "\r\n")
|
||||
|
@ -1,10 +1,15 @@
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
||||
|
||||
module Ormolu.Fixity.PrinterSpec (spec) where
|
||||
|
||||
import Data.Char qualified as Char
|
||||
import Data.List (intercalate)
|
||||
import Data.List.NonEmpty qualified as NE
|
||||
import Data.Map.Strict qualified as Map
|
||||
import Data.Text qualified as T
|
||||
import Distribution.ModuleName (ModuleName)
|
||||
import Distribution.ModuleName qualified as ModuleName
|
||||
import Distribution.Types.PackageName (PackageName, mkPackageName)
|
||||
import Ormolu.Fixity
|
||||
import Ormolu.Fixity.Parser
|
||||
import Ormolu.Fixity.Printer
|
||||
@ -12,26 +17,19 @@ import Test.Hspec
|
||||
import Test.Hspec.Megaparsec
|
||||
import Test.QuickCheck
|
||||
|
||||
newtype FixityMapWrapper = FixityMapWrapper FixityOverrides
|
||||
deriving (Show)
|
||||
|
||||
instance Arbitrary FixityMapWrapper where
|
||||
instance Arbitrary FixityOverrides where
|
||||
arbitrary =
|
||||
FixityMapWrapper . FixityOverrides . Map.fromList
|
||||
FixityOverrides . Map.fromList
|
||||
<$> listOf ((,) <$> genOperator <*> genFixityInfo)
|
||||
where
|
||||
scaleDown = scale (`div` 4)
|
||||
genOperator =
|
||||
OpName . T.pack <$> oneof [genNormalOperator, genIdentifier]
|
||||
genNormalOperator =
|
||||
listOf1 (scaleDown arbitrary `suchThat` isOperatorConstituent)
|
||||
isOperatorConstituent x =
|
||||
(Char.isSymbol x || Char.isPunctuation x) && x `notElem` ",`()"
|
||||
genIdentifier = do
|
||||
x <- arbitrary `suchThat` Char.isLetter
|
||||
x <- arbitrary `suchThat` isIdentifierFirstChar
|
||||
xs <- listOf1 (scaleDown arbitrary `suchThat` isIdentifierConstituent)
|
||||
return (x : xs)
|
||||
isIdentifierConstituent x = Char.isAlphaNum x || x == '_' || x == '\''
|
||||
genFixityInfo = do
|
||||
fiDirection <-
|
||||
elements
|
||||
@ -42,9 +40,36 @@ instance Arbitrary FixityMapWrapper where
|
||||
fiPrecedence <- chooseInt (0, 9)
|
||||
return FixityInfo {..}
|
||||
|
||||
instance Arbitrary ModuleReexports where
|
||||
arbitrary = ModuleReexports . Map.fromListWith combine <$> listOf genReexport
|
||||
where
|
||||
combine x y = NE.sort (x <> y)
|
||||
genReexport = do
|
||||
exportingModule <- arbitrary
|
||||
exports <- NE.sort . NE.fromList . getNonEmpty <$> scaleDown arbitrary
|
||||
return (exportingModule, exports)
|
||||
|
||||
instance Arbitrary PackageName where
|
||||
arbitrary =
|
||||
mkPackageName
|
||||
<$> listOf1 (scaleDown arbitrary `suchThat` isPackageNameConstituent)
|
||||
|
||||
instance Arbitrary ModuleName where
|
||||
arbitrary =
|
||||
ModuleName.fromString . intercalate "." <$> scaleDown (listOf1 genSegment)
|
||||
where
|
||||
genSegment = do
|
||||
x <- arbitrary `suchThat` isModuleSegmentFirstChar
|
||||
xs <- listOf (arbitrary `suchThat` isModuleSegmentConstituent)
|
||||
return (x : xs)
|
||||
|
||||
scaleDown :: Gen a -> Gen a
|
||||
scaleDown = scale (`div` 4)
|
||||
|
||||
spec :: Spec
|
||||
spec = do
|
||||
describe "parseFixityOverrides & printFixityOverrides" $
|
||||
it "arbitrary fixity maps are printed and parsed back correctly" $
|
||||
property $ \(FixityMapWrapper fixityMap) ->
|
||||
parseFixityOverrides "" (printFixityOverrides fixityMap) `shouldParse` fixityMap
|
||||
property $ \fixityOverrides moduleReexports ->
|
||||
parseDotOrmolu "" (printDotOrmolu fixityOverrides moduleReexports)
|
||||
`shouldParse` (fixityOverrides, moduleReexports)
|
||||
|
@ -4,6 +4,8 @@
|
||||
module Ormolu.FixitySpec (spec) where
|
||||
|
||||
import Data.Function ((&))
|
||||
import Data.List.NonEmpty (NonEmpty (..))
|
||||
import Data.Map.Strict qualified as Map
|
||||
import Data.Set qualified as Set
|
||||
import Data.Text qualified as T
|
||||
import Distribution.ModuleName (ModuleName)
|
||||
@ -196,6 +198,52 @@ spec = do
|
||||
["esqueleto"]
|
||||
[package_ "bob" $ import_ "Database.Esqueleto.Experimental"]
|
||||
[(unqual "++.", defaultFixityApproximation)]
|
||||
it "default module re-exports: Control.Lens brings into scope Control.Lens.Lens" $
|
||||
checkFixities
|
||||
["lens"]
|
||||
( applyModuleReexports
|
||||
defaultModuleReexports
|
||||
[import_ "Control.Lens"]
|
||||
)
|
||||
[(unqual "<+~", FixityApproximation (Just InfixR) 4 4)]
|
||||
it "default module re-exports: Control.Lens qualified brings into scope Control.Lens.Lens" $
|
||||
checkFixities
|
||||
["lens"]
|
||||
( applyModuleReexports
|
||||
defaultModuleReexports
|
||||
[import_ "Control.Lens" & qualified_]
|
||||
)
|
||||
[ (unqual "<+~", defaultFixityApproximation),
|
||||
(qual "Control.Lens.Lens" "<+~", defaultFixityApproximation),
|
||||
(qual "Control.Lens" "<+~", FixityApproximation (Just InfixR) 4 4)
|
||||
]
|
||||
it "default module re-exports: Control.Lens qualified as brings into scope Control.Lens.Lens" $
|
||||
checkFixities
|
||||
["lens"]
|
||||
( applyModuleReexports
|
||||
defaultModuleReexports
|
||||
[import_ "Control.Lens" & qualified_ & as_ "L"]
|
||||
)
|
||||
[ (unqual "<+~", defaultFixityApproximation),
|
||||
(qual "Control.Lens.Lens" "<+~", defaultFixityApproximation),
|
||||
(qual "Control.Lens" "<+~", defaultFixityApproximation),
|
||||
(qual "L" "<+~", FixityApproximation (Just InfixR) 4 4)
|
||||
]
|
||||
it "re-export chains: exported module can itself re-export another module" $ do
|
||||
let reexports =
|
||||
ModuleReexports $
|
||||
Map.insert
|
||||
"Foo"
|
||||
("Control.Lens" :| [])
|
||||
(unModuleReexports defaultModuleReexports)
|
||||
checkFixities
|
||||
["lens"]
|
||||
( applyModuleReexports
|
||||
reexports
|
||||
[import_ "Foo"]
|
||||
)
|
||||
[ (unqual "<+~", FixityApproximation (Just InfixR) 4 4)
|
||||
]
|
||||
|
||||
-- | Build a fixity map using the Hoogle database and then check the fixity
|
||||
-- of the specified subset of operators.
|
||||
@ -241,7 +289,7 @@ import_ :: ModuleName -> FixityImport
|
||||
import_ moduleName =
|
||||
FixityImport
|
||||
{ fimportPackage = Nothing,
|
||||
fimportModuleName = moduleName,
|
||||
fimportModule = moduleName,
|
||||
fimportQualified = UnqualifiedAndQualified moduleName,
|
||||
fimportList = Nothing
|
||||
}
|
||||
|
@ -3,5 +3,5 @@
|
||||
, "^Paths_"
|
||||
, "^Ormolu.Terminal.QualifiedDo.>>\$" -- https://github.com/ocharles/weeder/issues/112
|
||||
]
|
||||
, type-class-roots = False
|
||||
, type-class-roots = True
|
||||
}
|
||||
|
Loading…
Reference in New Issue
Block a user