mirror of
https://github.com/tweag/ormolu.git
synced 2024-09-11 13:16:13 +03:00
Don't use String
for operator and package names
This commit is contained in:
parent
af02809ebe
commit
45eaf2a838
@ -24,7 +24,7 @@ import Language.Haskell.TH.Env (envQ)
|
||||
import Options.Applicative
|
||||
import Ormolu
|
||||
import Ormolu.Diff.Text (diffText, printTextDiff)
|
||||
import Ormolu.Fixity (FixityInfo)
|
||||
import Ormolu.Fixity (FixityInfo, OpName)
|
||||
import Ormolu.Parser (manualExts)
|
||||
import Ormolu.Terminal
|
||||
import Ormolu.Utils (showOutputable)
|
||||
@ -359,7 +359,7 @@ parseMode = eitherReader $ \case
|
||||
s -> Left $ "unknown mode: " ++ s
|
||||
|
||||
-- | Parse a fixity declaration.
|
||||
parseFixityDeclaration :: ReadM [(String, FixityInfo)]
|
||||
parseFixityDeclaration :: ReadM [(OpName, FixityInfo)]
|
||||
parseFixityDeclaration = eitherReader parseFixityDeclarationStr
|
||||
|
||||
-- | Parse 'ColorMode'.
|
||||
|
@ -10,6 +10,7 @@ executable extract-hackage-info
|
||||
default-language: Haskell2010
|
||||
ghc-options: -O2 -Wall -rtsopts -Wunused-packages
|
||||
build-depends:
|
||||
Cabal-syntax >=3.8 && <3.9,
|
||||
base >=4.12 && <5.0,
|
||||
binary >=0.8 && <0.9,
|
||||
bytestring >=0.10 && <0.12,
|
||||
|
Binary file not shown.
@ -31,6 +31,7 @@ import qualified Data.Text as T
|
||||
import Data.Text.Encoding (decodeLatin1)
|
||||
import qualified Data.Text.IO as TIO
|
||||
import Data.Void (Void)
|
||||
import Distribution.Types.PackageName (PackageName, mkPackageName, unPackageName)
|
||||
import Formatting
|
||||
import Options.Applicative
|
||||
import Ormolu.Fixity hiding (packageToOps, packageToPopularity)
|
||||
@ -61,7 +62,7 @@ data State = State
|
||||
-- conflicting fixity declarations for a same operator
|
||||
-- (called self-conflicts), and we want to emit a warning message later
|
||||
-- for these
|
||||
sPackageToOps :: Map String (Map String [FixityInfo]),
|
||||
sPackageToOps :: Map PackageName (Map OpName [FixityInfo]),
|
||||
-- | How many Hoogle files have been processed
|
||||
sProcessedFiles :: Int
|
||||
}
|
||||
@ -103,7 +104,7 @@ getPackageName ::
|
||||
-- | Path to the Hoogle file
|
||||
FilePath ->
|
||||
-- | Package name extracted from the Hoogle file
|
||||
IO Text
|
||||
IO PackageName
|
||||
getPackageName rootPath filePath = do
|
||||
unless (rootPath `isPrefixOf` filePath) $
|
||||
exitWithMsg $
|
||||
@ -119,7 +120,7 @@ getPackageName rootPath filePath = do
|
||||
("Extracted package name is empty for " % string % " (base path = " % string % ")")
|
||||
filePath
|
||||
rootPath
|
||||
return packageName
|
||||
pure . mkPackageName . T.unpack $ packageName
|
||||
|
||||
-- | Try to read the specified file using utf-8 encoding first,
|
||||
-- and latin1 otherwise.
|
||||
@ -137,47 +138,46 @@ readFileUtf8Latin1 filePath = catch @IOException (TIO.readFile filePath) $
|
||||
-- e.g. @(+) :: Num a => a -> a -> a@, update the fixity map accordingly.
|
||||
onSymbolDecl ::
|
||||
-- | Name of the package in which the symbol declaration was found
|
||||
Text ->
|
||||
PackageName ->
|
||||
-- | Symbol name extracted from the symbol declaration in the Hoogle file
|
||||
String ->
|
||||
OpName ->
|
||||
-- | Current state
|
||||
State ->
|
||||
-- | Updated state
|
||||
State
|
||||
onSymbolDecl packageName declOpName state@State {..} =
|
||||
let sPackageToOps' = case Map.lookup packageName' sPackageToOps of
|
||||
let sPackageToOps' = case Map.lookup packageName sPackageToOps of
|
||||
Nothing ->
|
||||
Map.insert
|
||||
packageName'
|
||||
packageName
|
||||
(Map.singleton declOpName [])
|
||||
sPackageToOps
|
||||
Just packageFixityMap ->
|
||||
case Map.lookup declOpName packageFixityMap of
|
||||
Nothing ->
|
||||
Map.insert
|
||||
packageName'
|
||||
packageName
|
||||
(Map.insert declOpName [] packageFixityMap)
|
||||
sPackageToOps
|
||||
Just _ -> sPackageToOps
|
||||
packageName' = T.unpack packageName
|
||||
in state {sPackageToOps = sPackageToOps'}
|
||||
|
||||
-- | When a fixity declaration is encountered, e.g. @infixr 5 :@, update the
|
||||
-- fixity map accordingly.
|
||||
onFixityDecl ::
|
||||
-- | Name of the package in which the symbol declaration was found
|
||||
Text ->
|
||||
PackageName ->
|
||||
-- | Tuple of operator name and fixity info
|
||||
(String, FixityInfo) ->
|
||||
(OpName, FixityInfo) ->
|
||||
-- | Current state
|
||||
State ->
|
||||
-- | Updated state
|
||||
State
|
||||
onFixityDecl packageName (opName, fixDecl) state@State {..} =
|
||||
let sPackageToOps' = case Map.lookup packageName' sPackageToOps of
|
||||
let sPackageToOps' = case Map.lookup packageName sPackageToOps of
|
||||
Nothing ->
|
||||
Map.insert
|
||||
packageName'
|
||||
packageName
|
||||
(Map.singleton opName [fixDecl])
|
||||
sPackageToOps
|
||||
Just packageFixityMap ->
|
||||
@ -187,21 +187,20 @@ onFixityDecl packageName (opName, fixDecl) state@State {..} =
|
||||
sPackageToOps
|
||||
fixDecls ->
|
||||
Map.insert
|
||||
packageName'
|
||||
packageName
|
||||
( Map.insert
|
||||
opName
|
||||
(fixDecl : fixDecls)
|
||||
packageFixityMap
|
||||
)
|
||||
sPackageToOps
|
||||
packageName' = T.unpack packageName
|
||||
in state {sPackageToOps = sPackageToOps'}
|
||||
|
||||
-- | Represent an operator for which we found conflicting definitions
|
||||
-- originating from the same package.
|
||||
data SelfConflict = SelfConflict
|
||||
{ scPackageName :: String,
|
||||
scOperatorName :: String,
|
||||
{ scPackageName :: PackageName,
|
||||
scOperatorName :: OpName,
|
||||
scConflictingDefs :: [FixityInfo]
|
||||
}
|
||||
|
||||
@ -210,8 +209,8 @@ data SelfConflict = SelfConflict
|
||||
-- (where conflicting definitions from self-conflicts are merged), and also
|
||||
-- return the list of self-conflicts
|
||||
finalizePackageToOps ::
|
||||
Map String (Map String [FixityInfo]) ->
|
||||
(Map String (Map String FixityInfo), [SelfConflict])
|
||||
Map PackageName (Map OpName [FixityInfo]) ->
|
||||
(Map PackageName (Map OpName FixityInfo), [SelfConflict])
|
||||
finalizePackageToOps hashmap =
|
||||
( Map.map (Map.map finalize) hashmap,
|
||||
concatMap injectFst
|
||||
@ -252,9 +251,9 @@ extractFixitiesFromFile
|
||||
-- | The types of declarations in the Hoogle files we are interested in.
|
||||
data DeclType
|
||||
= -- | See third argument of 'onSymbolDecl'.
|
||||
SymbolDecl String
|
||||
SymbolDecl OpName
|
||||
| -- | See third argument of 'onFixityDecl'.
|
||||
FixityDecl (String, FixityInfo)
|
||||
FixityDecl (OpName, FixityInfo)
|
||||
|
||||
-- | Parse all 'DeclType's in some file content.
|
||||
parseDecls :: Text -> [DeclType]
|
||||
@ -278,7 +277,7 @@ parseDecls = either mempty id . MP.runParser pDecls ""
|
||||
extractHoogleInfo ::
|
||||
-- | Path to the hoogle directory containing all package directories
|
||||
FilePath ->
|
||||
IO (Map String FixityMap)
|
||||
IO (Map PackageName FixityMap)
|
||||
extractHoogleInfo hoogleDatabasePath = do
|
||||
hoogleFiles <- walkDir hoogleDatabasePath
|
||||
State {..} <-
|
||||
@ -315,12 +314,12 @@ displaySelfConflicts selfConflicts =
|
||||
showSc SelfConflict {scPackageName, scOperatorName, scConflictingDefs} =
|
||||
sformat
|
||||
("(in " % string % ") " % string)
|
||||
scPackageName
|
||||
scOperatorName
|
||||
(unPackageName scPackageName)
|
||||
(T.unpack $ unOpName scOperatorName)
|
||||
: indentLines (showT <$> scConflictingDefs)
|
||||
|
||||
-- | Display stats about the Hoogle database processing.
|
||||
displayFixityStats :: Map String FixityMap -> IO ()
|
||||
displayFixityStats :: Map PackageName FixityMap -> IO ()
|
||||
displayFixityStats packageToOps =
|
||||
hprintLn
|
||||
stdout
|
||||
@ -348,7 +347,7 @@ extractHackageInfo ::
|
||||
-- | Path to the Hackage HTML page
|
||||
FilePath ->
|
||||
-- | Map packageName -> download count
|
||||
IO (Map String Int)
|
||||
IO (Map PackageName Int)
|
||||
extractHackageInfo filePath = do
|
||||
content <- TIO.readFile filePath
|
||||
let soup = filterBlankTags $ parseTags content
|
||||
@ -357,7 +356,7 @@ extractHackageInfo filePath = do
|
||||
takeWhile (not . tagCloseLit "table") $
|
||||
dropWhile (not . tagOpenLit "table" (const True)) soup
|
||||
processRow tags = case extractText <$> groupOn "td" tags of
|
||||
rawName : rawDlCount : _ -> return $ Just (name, dlCount)
|
||||
rawName : rawDlCount : _ -> return $ Just (mkPackageName name, dlCount)
|
||||
where
|
||||
name = T.unpack . T.strip . head $ T.split (== ' ') rawName
|
||||
dlCount = readT $ T.strip rawDlCount :: Int
|
||||
|
@ -161,6 +161,7 @@ test-suite tests
|
||||
|
||||
default-language: Haskell2010
|
||||
build-depends:
|
||||
Cabal-syntax >=3.8 && <3.9,
|
||||
QuickCheck >=2.14,
|
||||
base >=4.14 && <5.0,
|
||||
containers >=0.5 && <0.7,
|
||||
|
@ -19,6 +19,7 @@ where
|
||||
import qualified Data.Map.Strict as Map
|
||||
import Data.Set (Set)
|
||||
import qualified Data.Set as Set
|
||||
import Distribution.Types.PackageName (PackageName)
|
||||
import GHC.Generics (Generic)
|
||||
import qualified GHC.Types.SrcLoc as GHC
|
||||
import Ormolu.Fixity (FixityMap)
|
||||
@ -39,7 +40,7 @@ data Config region = Config
|
||||
-- | Fixity overrides
|
||||
cfgFixityOverrides :: FixityMap,
|
||||
-- | Known dependencies, if any
|
||||
cfgDependencies :: !(Set String),
|
||||
cfgDependencies :: !(Set PackageName),
|
||||
-- | Do formatting faster but without automatic detection of defects
|
||||
cfgUnsafe :: !Bool,
|
||||
-- | Output information useful for debugging
|
||||
|
@ -1,10 +1,16 @@
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE MultiWayIf #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE PatternSynonyms #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
|
||||
-- | Definitions for fixity analysis.
|
||||
module Ormolu.Fixity
|
||||
( FixityDirection (..),
|
||||
( OpName,
|
||||
pattern OpName,
|
||||
unOpName,
|
||||
occOpName,
|
||||
FixityDirection (..),
|
||||
FixityInfo (..),
|
||||
FixityMap,
|
||||
LazyFixityMap,
|
||||
@ -30,14 +36,15 @@ import qualified Data.List.NonEmpty as NE
|
||||
import Data.Map.Strict (Map)
|
||||
import qualified Data.Map.Strict as Map
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Data.MemoTrie (HasTrie, memo)
|
||||
import Data.MemoTrie (memo)
|
||||
import Data.Semigroup (sconcat)
|
||||
import Data.Set (Set)
|
||||
import qualified Data.Set as Set
|
||||
import Distribution.Types.PackageName (PackageName, mkPackageName, unPackageName)
|
||||
import Ormolu.Fixity.Internal
|
||||
|
||||
packageToOps :: Map String FixityMap
|
||||
packageToPopularity :: Map String Int
|
||||
packageToOps :: Map PackageName FixityMap
|
||||
packageToPopularity :: Map PackageName Int
|
||||
HackageInfo packageToOps packageToPopularity =
|
||||
Binary.runGet Binary.get $
|
||||
BL.fromStrict $(embedFile "extract-hackage-info/hackage-info.bin")
|
||||
@ -47,7 +54,7 @@ HackageInfo packageToOps packageToPopularity =
|
||||
-- See https://github.com/tweag/ormolu/pull/830#issuecomment-986609572.
|
||||
-- "base" is not is this list, because it is already whitelisted
|
||||
-- by buildFixityMap'.
|
||||
bootPackages :: Set String
|
||||
bootPackages :: Set PackageName
|
||||
bootPackages =
|
||||
Set.fromList
|
||||
[ "array",
|
||||
@ -87,7 +94,7 @@ buildFixityMap ::
|
||||
-- instead of being merged with them
|
||||
Float ->
|
||||
-- | Explicitly known dependencies
|
||||
Set String ->
|
||||
Set PackageName ->
|
||||
-- | Resulting map
|
||||
LazyFixityMap
|
||||
buildFixityMap = buildFixityMap' packageToOps packageToPopularity bootPackages
|
||||
@ -98,17 +105,17 @@ buildFixityMap = buildFixityMap' packageToOps packageToPopularity bootPackages
|
||||
-- specify the package databases used to build the final fixity map.
|
||||
buildFixityMap' ::
|
||||
-- | Map from package to fixity map for operators defined in this package
|
||||
Map String FixityMap ->
|
||||
Map PackageName FixityMap ->
|
||||
-- | Map from package to popularity
|
||||
Map String Int ->
|
||||
Map PackageName Int ->
|
||||
-- | Higher priority packages
|
||||
Set String ->
|
||||
Set PackageName ->
|
||||
-- | Popularity ratio threshold, after which a very popular package will
|
||||
-- completely rule out conflicting definitions coming from other packages
|
||||
-- instead of being merged with them
|
||||
Float ->
|
||||
-- | Explicitly known dependencies
|
||||
Set String ->
|
||||
Set PackageName ->
|
||||
-- | Resulting map
|
||||
LazyFixityMap
|
||||
buildFixityMap'
|
||||
@ -147,8 +154,8 @@ buildFixityMap'
|
||||
remainingFixityMap
|
||||
]
|
||||
|
||||
memoSet :: (HasTrie a, Eq a) => (Set a -> v) -> Set a -> v
|
||||
memoSet f = memo (f . Set.fromAscList) . Set.toAscList
|
||||
memoSet :: (Set PackageName -> v) -> Set PackageName -> v
|
||||
memoSet f = memo (f . Set.fromAscList . fmap mkPackageName) . fmap unPackageName . Set.toAscList
|
||||
|
||||
-- | Merge a list of individual fixity maps, coming from different packages.
|
||||
-- Package popularities and the given threshold are used to choose between
|
||||
@ -156,11 +163,11 @@ memoSet f = memo (f . Set.fromAscList) . Set.toAscList
|
||||
-- strategies when conflicting definitions are encountered for an operator.
|
||||
mergeFixityMaps ::
|
||||
-- | Map from package name to 30-days download count
|
||||
Map String Int ->
|
||||
Map PackageName Int ->
|
||||
-- | Popularity ratio threshold
|
||||
Float ->
|
||||
-- | List of (package name, package fixity map) to merge
|
||||
[(String, FixityMap)] ->
|
||||
[(PackageName, FixityMap)] ->
|
||||
-- | Resulting fixity map
|
||||
FixityMap
|
||||
mergeFixityMaps popularityMap threshold packageMaps =
|
||||
@ -174,7 +181,7 @@ mergeFixityMaps popularityMap threshold packageMaps =
|
||||
-- op1 -map-> {definitions1 -map-> originPackages}
|
||||
-- op1 -map-> {definitions2 -map-> originPackages}
|
||||
-- so we merge the keys (which have the type:
|
||||
-- Map FixityInfo (NonEmpty String))
|
||||
-- Map FixityInfo (NonEmpty PackageName))
|
||||
-- using 'Map.unionWith (<>)', to "concatenate" the list of
|
||||
-- definitions for this operator, and to also "concatenate" origin
|
||||
-- packages if a same definition is found in both maps
|
||||
@ -202,7 +209,7 @@ mergeFixityMaps popularityMap threshold packageMaps =
|
||||
getScores ::
|
||||
-- Map for a given operator associating each of its conflicting
|
||||
-- definitions with the packages that define it
|
||||
Map FixityInfo (NonEmpty String) ->
|
||||
Map FixityInfo (NonEmpty PackageName) ->
|
||||
-- Map for a given operator associating each of its conflicting
|
||||
-- definitions with their score (= sum of the popularity of the
|
||||
-- packages that define it)
|
||||
@ -212,13 +219,13 @@ mergeFixityMaps popularityMap threshold packageMaps =
|
||||
(sum . fmap (fromMaybe 0 . flip Map.lookup popularityMap))
|
||||
opFixityMapFrom ::
|
||||
-- (packageName, package fixity map)
|
||||
(String, FixityMap) ->
|
||||
(PackageName, FixityMap) ->
|
||||
-- Map associating each operator of the package with a
|
||||
-- {map for a given operator associating each of its definitions with
|
||||
-- the list of packages that define it}
|
||||
-- (this list can only be == [packageName] in the context of this
|
||||
-- function)
|
||||
Map String (Map FixityInfo (NonEmpty String))
|
||||
Map OpName (Map FixityInfo (NonEmpty PackageName))
|
||||
opFixityMapFrom (packageName, opsMap) =
|
||||
Map.map
|
||||
(flip Map.singleton (packageName :| []))
|
||||
|
@ -1,12 +1,19 @@
|
||||
{-# LANGUAGE DeriveAnyClass #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE DerivingStrategies #-}
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE PatternSynonyms #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE ViewPatterns #-}
|
||||
|
||||
module Ormolu.Fixity.Internal
|
||||
( FixityDirection (..),
|
||||
( OpName,
|
||||
pattern OpName,
|
||||
unOpName,
|
||||
occOpName,
|
||||
FixityDirection (..),
|
||||
FixityInfo (..),
|
||||
defaultFixityInfo,
|
||||
colonFixityInfo,
|
||||
@ -18,10 +25,19 @@ module Ormolu.Fixity.Internal
|
||||
where
|
||||
|
||||
import Data.Binary (Binary)
|
||||
import Data.ByteString.Short (ShortByteString)
|
||||
import qualified Data.ByteString.Short as SBS
|
||||
import Data.Foldable (asum)
|
||||
import Data.Map.Strict (Map)
|
||||
import qualified Data.Map.Strict as Map
|
||||
import Data.String (IsString (..))
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Encoding as T
|
||||
import Distribution.Types.PackageName (PackageName)
|
||||
import GHC.Data.FastString (fs_sbs)
|
||||
import GHC.Generics (Generic)
|
||||
import GHC.Types.Name (OccName (occNameFS))
|
||||
|
||||
-- | Fixity direction.
|
||||
data FixityDirection
|
||||
@ -79,8 +95,36 @@ instance Semigroup FixityInfo where
|
||||
(Just a, Just b) | a == b -> Just a
|
||||
_ -> Nothing
|
||||
|
||||
-- | An operator name.
|
||||
newtype OpName = MkOpName
|
||||
{ -- | Invariant: UTF-8 encoded
|
||||
getOpName :: ShortByteString
|
||||
}
|
||||
deriving newtype (Eq, Ord, Binary)
|
||||
|
||||
-- | Convert an 'OpName' to 'Text'.
|
||||
unOpName :: OpName -> Text
|
||||
unOpName = T.decodeUtf8 . SBS.fromShort . getOpName
|
||||
|
||||
pattern OpName :: Text -> OpName
|
||||
pattern OpName opName <- (unOpName -> opName)
|
||||
where
|
||||
OpName = MkOpName . SBS.toShort . T.encodeUtf8
|
||||
|
||||
{-# COMPLETE OpName #-}
|
||||
|
||||
-- | Convert an 'OccName to an 'OpName'.
|
||||
occOpName :: OccName -> OpName
|
||||
occOpName = MkOpName . fs_sbs . occNameFS
|
||||
|
||||
instance Show OpName where
|
||||
show = T.unpack . unOpName
|
||||
|
||||
instance IsString OpName where
|
||||
fromString = OpName . T.pack
|
||||
|
||||
-- | Map from the operator name to its 'FixityInfo'.
|
||||
type FixityMap = Map String FixityInfo
|
||||
type FixityMap = Map OpName FixityInfo
|
||||
|
||||
-- | A variant of 'FixityMap', represented as a lazy union of several
|
||||
-- 'FixityMap's.
|
||||
@ -89,16 +133,16 @@ newtype LazyFixityMap = LazyFixityMap [FixityMap]
|
||||
|
||||
-- | Lookup a 'FixityInfo' of an operator. This might have drastically
|
||||
-- different performance depending on whether this is an "unusual" operator.
|
||||
lookupFixity :: String -> LazyFixityMap -> Maybe FixityInfo
|
||||
lookupFixity :: OpName -> LazyFixityMap -> Maybe FixityInfo
|
||||
lookupFixity op (LazyFixityMap maps) = asum (Map.lookup op <$> maps)
|
||||
|
||||
-- | The map of operators declared by each package and the popularity of
|
||||
-- each package, if available.
|
||||
data HackageInfo
|
||||
= HackageInfo
|
||||
(Map String FixityMap)
|
||||
(Map PackageName FixityMap)
|
||||
-- ^ Map from package name to a map from operator name to its fixity
|
||||
(Map String Int)
|
||||
(Map PackageName Int)
|
||||
-- ^ Map from package name to its 30-days download count from Hackage
|
||||
deriving stock (Generic)
|
||||
deriving anyclass (Binary)
|
||||
|
@ -16,8 +16,9 @@ where
|
||||
import qualified Data.Char as Char
|
||||
import qualified Data.Map.Strict as Map
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import Data.Void (Void)
|
||||
import Ormolu.Fixity.Internal
|
||||
import Ormolu.Fixity
|
||||
import Text.Megaparsec
|
||||
import Text.Megaparsec.Char
|
||||
import qualified Text.Megaparsec.Char.Lexer as L
|
||||
@ -39,7 +40,7 @@ parseFixityDeclaration ::
|
||||
-- | Expression to parse
|
||||
Text ->
|
||||
-- | Parse result
|
||||
Either (ParseErrorBundle Text Void) [(String, FixityInfo)]
|
||||
Either (ParseErrorBundle Text Void) [(OpName, FixityInfo)]
|
||||
parseFixityDeclaration = runParser (pFixity <* eof) ""
|
||||
|
||||
pFixityMap :: Parser FixityMap
|
||||
@ -51,7 +52,7 @@ pFixityMap =
|
||||
-- | Parse a single fixity declaration, such as
|
||||
--
|
||||
-- > infixr 4 +++, >>>
|
||||
pFixity :: Parser [(String, FixityInfo)]
|
||||
pFixity :: Parser [(OpName, FixityInfo)]
|
||||
pFixity = do
|
||||
fiDirection <- Just <$> pFixityDirection
|
||||
hidden hspace1
|
||||
@ -72,19 +73,16 @@ pFixityDirection =
|
||||
]
|
||||
|
||||
-- | See <https://www.haskell.org/onlinereport/haskell2010/haskellch2.html>
|
||||
pOperator :: Parser String
|
||||
pOperator = tickedOperator <|> normalOperator
|
||||
pOperator :: Parser OpName
|
||||
pOperator = OpName <$> (tickedOperator <|> normalOperator)
|
||||
where
|
||||
tickedOperator = between tick tick haskellIdentifier
|
||||
tick = char '`'
|
||||
haskellIdentifier = do
|
||||
x <- letterChar
|
||||
xs <- many (alphaNumChar <|> char '_' <|> char '\'')
|
||||
return (x : xs)
|
||||
normalOperator = some operatorChar
|
||||
operatorChar =
|
||||
satisfy
|
||||
(\x -> (Char.isSymbol x || Char.isPunctuation x) && isNotExcluded x)
|
||||
<?> "operator character"
|
||||
where
|
||||
isNotExcluded x = x /= ',' && x /= '`' && x /= '(' && x /= ')'
|
||||
haskellIdentifier =
|
||||
T.cons
|
||||
<$> letterChar
|
||||
<*> takeWhileP Nothing (\x -> Char.isAlphaNum x || x == '_' || x == '\'')
|
||||
normalOperator =
|
||||
takeWhile1P (Just "operator character") $ \x ->
|
||||
(Char.isSymbol x || Char.isPunctuation x)
|
||||
&& (x /= ',' && x /= '`' && x /= '(' && x /= ')')
|
||||
|
@ -10,11 +10,12 @@ where
|
||||
import qualified Data.Char as Char
|
||||
import qualified Data.Map.Strict as Map
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Lazy as TL
|
||||
import Data.Text.Lazy.Builder (Builder)
|
||||
import qualified Data.Text.Lazy.Builder as B
|
||||
import qualified Data.Text.Lazy.Builder.Int as B
|
||||
import Ormolu.Fixity.Internal
|
||||
import Ormolu.Fixity
|
||||
|
||||
-- | Print out a textual representation of a 'FixityMap'.
|
||||
printFixityMap :: FixityMap -> Text
|
||||
@ -26,7 +27,7 @@ printFixityMap =
|
||||
. concatMap decompose
|
||||
. Map.toList
|
||||
where
|
||||
decompose :: (String, FixityInfo) -> [(FixityDirection, Int, String)]
|
||||
decompose :: (OpName, FixityInfo) -> [(FixityDirection, Int, OpName)]
|
||||
decompose (operator, FixityInfo {..}) =
|
||||
let forDirection dir =
|
||||
(dir, fiMinPrecedence, operator)
|
||||
@ -36,8 +37,8 @@ printFixityMap =
|
||||
in case fiDirection of
|
||||
Nothing -> concatMap forDirection [InfixL, InfixR]
|
||||
Just dir -> forDirection dir
|
||||
renderOne :: (FixityDirection, Int, String) -> Builder
|
||||
renderOne (fixityDirection, n, operator) =
|
||||
renderOne :: (FixityDirection, Int, OpName) -> Builder
|
||||
renderOne (fixityDirection, n, OpName operator) =
|
||||
mconcat
|
||||
[ case fixityDirection of
|
||||
InfixL -> "infixl"
|
||||
@ -47,9 +48,8 @@ printFixityMap =
|
||||
B.decimal n,
|
||||
" ",
|
||||
if isTickedOperator operator
|
||||
then "`" <> B.fromString operator <> "`"
|
||||
else B.fromString operator,
|
||||
then "`" <> B.fromText operator <> "`"
|
||||
else B.fromText operator,
|
||||
"\n"
|
||||
]
|
||||
isTickedOperator [] = True
|
||||
isTickedOperator (x : _) = Char.isLetter x
|
||||
isTickedOperator = maybe True (Char.isLetter . fst) . T.uncons
|
||||
|
@ -16,7 +16,6 @@ import Control.Applicative ((<|>))
|
||||
import qualified Data.List.NonEmpty as NE
|
||||
import qualified Data.Map.Strict as Map
|
||||
import Data.Maybe (fromMaybe)
|
||||
import GHC.Types.Name.Occurrence (occNameString)
|
||||
import GHC.Types.Name.Reader
|
||||
import GHC.Types.SrcLoc
|
||||
import Ormolu.Fixity
|
||||
@ -44,10 +43,10 @@ data OpTree ty op
|
||||
data OpInfo op = OpInfo
|
||||
{ -- | The actual operator
|
||||
opiOp :: op,
|
||||
-- | Its name, if available. We use 'Maybe String' here instead of
|
||||
-- 'String' because the name-fetching function received by
|
||||
-- 'reassociateOpTree' returns a 'Maybe'
|
||||
opiName :: Maybe String,
|
||||
-- | Its name, if available. We use 'Maybe OpName' here instead of 'OpName'
|
||||
-- because the name-fetching function received by 'reassociateOpTree'
|
||||
-- returns a 'Maybe'
|
||||
opiName :: Maybe OpName,
|
||||
-- | Information about the fixity direction and precedence level of the
|
||||
-- operator
|
||||
opiFix :: FixityInfo
|
||||
@ -125,7 +124,7 @@ addFixityInfo fixityOverrides fixityMap getOpName (OpBranches exprs ops) =
|
||||
where
|
||||
toOpInfo o = OpInfo o mName fixityInfo
|
||||
where
|
||||
mName = occNameString . rdrNameOcc <$> getOpName o
|
||||
mName = occOpName . rdrNameOcc <$> getOpName o
|
||||
fixityInfo =
|
||||
fromMaybe
|
||||
defaultFixityInfo
|
||||
|
@ -6,8 +6,6 @@
|
||||
module Ormolu.Utils.Cabal
|
||||
( CabalInfo (..),
|
||||
defaultCabalInfo,
|
||||
PackageName,
|
||||
unPackageName,
|
||||
Extension (..),
|
||||
getCabalInfoForSourceFile,
|
||||
findCabalFile,
|
||||
@ -41,11 +39,11 @@ import System.IO.Unsafe (unsafePerformIO)
|
||||
-- | Cabal information of interest to Ormolu.
|
||||
data CabalInfo = CabalInfo
|
||||
{ -- | Package name
|
||||
ciPackageName :: !(Maybe String),
|
||||
ciPackageName :: !(Maybe PackageName),
|
||||
-- | Extension and language settings in the form of 'DynOption's
|
||||
ciDynOpts :: ![DynOption],
|
||||
-- | Direct dependencies
|
||||
ciDependencies :: !(Set String),
|
||||
ciDependencies :: !(Set PackageName),
|
||||
-- | Absolute path to the cabal file, if it was found
|
||||
ciCabalFilePath :: !(Maybe FilePath)
|
||||
}
|
||||
@ -111,7 +109,7 @@ data CachedCabalFile = CachedCabalFile
|
||||
genericPackageDescription :: GenericPackageDescription,
|
||||
-- | Map from Haskell source file paths (without any extensions) to the
|
||||
-- corresponding 'DynOption's and dependencies.
|
||||
extensionsAndDeps :: Map FilePath ([DynOption], [String])
|
||||
extensionsAndDeps :: Map FilePath ([DynOption], [PackageName])
|
||||
}
|
||||
deriving (Show)
|
||||
|
||||
@ -153,10 +151,9 @@ parseCabalInfo cabalFileAsGiven sourceFileAsGiven = liftIO $ do
|
||||
<> sourceFileAsGiven
|
||||
return ([], [])
|
||||
let pdesc = packageDescription genericPackageDescription
|
||||
packageName = (unPackageName . pkgName . package) pdesc
|
||||
return
|
||||
CabalInfo
|
||||
{ ciPackageName = Just packageName,
|
||||
{ ciPackageName = Just . pkgName . package $ pdesc,
|
||||
ciDynOpts = dynOpts,
|
||||
ciDependencies = Set.fromList dependencies,
|
||||
ciCabalFilePath = Just cabalFile
|
||||
@ -172,7 +169,7 @@ getExtensionAndDepsMap ::
|
||||
FilePath ->
|
||||
-- | Parsed generic package description
|
||||
GenericPackageDescription ->
|
||||
Map FilePath ([DynOption], [String])
|
||||
Map FilePath ([DynOption], [PackageName])
|
||||
getExtensionAndDepsMap cabalFile GenericPackageDescription {..} =
|
||||
M.unions . concat $
|
||||
[ buildMap extractFromLibrary <$> lib ++ sublibs,
|
||||
@ -196,7 +193,7 @@ getExtensionAndDepsMap cabalFile GenericPackageDescription {..} =
|
||||
prependSrcDirs f
|
||||
| null hsSourceDirs = [f]
|
||||
| otherwise = (</> f) . getSymbolicPath <$> hsSourceDirs
|
||||
deps = unPackageName . depPkgName <$> targetBuildDepends
|
||||
deps = depPkgName <$> targetBuildDepends
|
||||
exts = maybe [] langExt defaultLanguage ++ fmap extToDynOption defaultExtensions
|
||||
langExt =
|
||||
pure . DynOption . ("-X" <>) . \case
|
||||
|
@ -64,6 +64,6 @@ parseFixityDeclarationStr ::
|
||||
-- | Input to parse
|
||||
String ->
|
||||
-- | Parse result
|
||||
Either String [(String, FixityInfo)]
|
||||
Either String [(OpName, FixityInfo)]
|
||||
parseFixityDeclarationStr =
|
||||
first errorBundlePretty . parseFixityDeclaration . T.pack
|
||||
|
@ -3,6 +3,7 @@
|
||||
module Ormolu.CabalInfoSpec (spec) where
|
||||
|
||||
import qualified Data.Set as Set
|
||||
import Distribution.Types.PackageName (unPackageName)
|
||||
import Ormolu.Config (DynOption (..))
|
||||
import Ormolu.Utils.Cabal
|
||||
import System.Directory
|
||||
@ -32,16 +33,16 @@ spec = do
|
||||
describe "parseCabalInfo" $ do
|
||||
it "extracts correct package name from ormolu.cabal" $ do
|
||||
CabalInfo {..} <- parseCabalInfo "ormolu.cabal" "src/Ormolu/Config.hs"
|
||||
ciPackageName `shouldBe` Just "ormolu"
|
||||
fmap unPackageName ciPackageName `shouldBe` Just "ormolu"
|
||||
it "extracts correct dyn opts from ormolu.cabal" $ do
|
||||
CabalInfo {..} <- parseCabalInfo "ormolu.cabal" "src/Ormolu/Config.hs"
|
||||
ciDynOpts `shouldBe` [DynOption "-XHaskell2010"]
|
||||
it "extracts correct dependencies from ormolu.cabal (src/Ormolu/Config.hs)" $ do
|
||||
CabalInfo {..} <- parseCabalInfo "ormolu.cabal" "src/Ormolu/Config.hs"
|
||||
ciDependencies `shouldBe` Set.fromList ["Cabal-syntax", "Diff", "MemoTrie", "ansi-terminal", "array", "base", "binary", "bytestring", "containers", "directory", "dlist", "file-embed", "filepath", "ghc-lib-parser", "megaparsec", "mtl", "syb", "text"]
|
||||
Set.map unPackageName ciDependencies `shouldBe` Set.fromList ["Cabal-syntax", "Diff", "MemoTrie", "ansi-terminal", "array", "base", "binary", "bytestring", "containers", "directory", "dlist", "file-embed", "filepath", "ghc-lib-parser", "megaparsec", "mtl", "syb", "text"]
|
||||
it "extracts correct dependencies from ormolu.cabal (tests/Ormolu/PrinterSpec.hs)" $ do
|
||||
CabalInfo {..} <- parseCabalInfo "ormolu.cabal" "tests/Ormolu/PrinterSpec.hs"
|
||||
ciDependencies `shouldBe` Set.fromList ["QuickCheck", "base", "containers", "directory", "filepath", "ghc-lib-parser", "hspec", "hspec-megaparsec", "ormolu", "path", "path-io", "temporary", "text"]
|
||||
Set.map unPackageName ciDependencies `shouldBe` Set.fromList ["Cabal-syntax", "QuickCheck", "base", "containers", "directory", "filepath", "ghc-lib-parser", "hspec", "hspec-megaparsec", "ormolu", "path", "path-io", "temporary", "text"]
|
||||
|
||||
it "handles `hs-source-dirs: .`" $ do
|
||||
CabalInfo {..} <- parseTestCabalInfo "Foo.hs"
|
||||
|
@ -4,6 +4,7 @@ module Ormolu.Fixity.PrinterSpec (spec) where
|
||||
|
||||
import qualified Data.Char as Char
|
||||
import qualified Data.Map.Strict as Map
|
||||
import qualified Data.Text as T
|
||||
import Ormolu.Fixity
|
||||
import Ormolu.Fixity.Parser
|
||||
import Ormolu.Fixity.Printer
|
||||
@ -20,7 +21,8 @@ instance Arbitrary FixityMapWrapper where
|
||||
<$> listOf ((,) <$> genOperator <*> genFixityInfo)
|
||||
where
|
||||
scaleDown = scale (`div` 4)
|
||||
genOperator = oneof [genNormalOperator, genIdentifier]
|
||||
genOperator =
|
||||
OpName . T.pack <$> oneof [genNormalOperator, genIdentifier]
|
||||
genNormalOperator =
|
||||
listOf1 (scaleDown arbitrary `suchThat` isOperatorConstituent)
|
||||
isOperatorConstituent x =
|
||||
|
@ -1,3 +1,4 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE TupleSections #-}
|
||||
|
||||
module Ormolu.HackageInfoSpec (spec) where
|
||||
@ -5,6 +6,7 @@ module Ormolu.HackageInfoSpec (spec) where
|
||||
import qualified Data.Map.Strict as Map
|
||||
import Data.Maybe (mapMaybe)
|
||||
import qualified Data.Set as Set
|
||||
import Distribution.Types.PackageName (PackageName)
|
||||
import Ormolu.Fixity
|
||||
import Test.Hspec
|
||||
|
||||
@ -13,12 +15,12 @@ import Test.Hspec
|
||||
-- operators.
|
||||
checkFixityMap ::
|
||||
-- | List of dependencies
|
||||
[String] ->
|
||||
[PackageName] ->
|
||||
-- | Threshold to choose the conflict resolution strategy
|
||||
Float ->
|
||||
-- | Associative list representing a subset of the resulting fixity map
|
||||
-- that should be checked.
|
||||
[(String, FixityInfo)] ->
|
||||
[(OpName, FixityInfo)] ->
|
||||
Expectation
|
||||
checkFixityMap
|
||||
dependencies
|
||||
@ -43,20 +45,20 @@ checkFixityMap
|
||||
checkFixityMap' ::
|
||||
-- | Associative list for packageToOps:
|
||||
-- package name -map-> (operator -map-> fixity)
|
||||
[(String, [(String, FixityInfo)])] ->
|
||||
[(PackageName, [(OpName, FixityInfo)])] ->
|
||||
-- | Associative list for packageToPopularity:
|
||||
-- package name -map-> download count
|
||||
[(String, Int)] ->
|
||||
[(PackageName, Int)] ->
|
||||
-- | List of packages that should have a higher priority than
|
||||
-- unspecified packages (boot packages)
|
||||
[String] ->
|
||||
[PackageName] ->
|
||||
-- | List of dependencies
|
||||
[String] ->
|
||||
[PackageName] ->
|
||||
-- | Threshold to choose the conflict resolution strategy
|
||||
Float ->
|
||||
-- | Associative list representing a subset of the resulting fixity map
|
||||
-- that should be checked.
|
||||
[(String, FixityInfo)] ->
|
||||
[(OpName, FixityInfo)] ->
|
||||
Expectation
|
||||
checkFixityMap'
|
||||
lPackageToOps
|
||||
|
@ -1,7 +1,11 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module Ormolu.OpTreeSpec (spec) where
|
||||
|
||||
import qualified Data.Map.Strict as Map
|
||||
import Data.Maybe (fromJust)
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import GHC.Types.Name (mkOccName, varName)
|
||||
import GHC.Types.Name.Reader (mkRdrUnqual)
|
||||
import Ormolu.Fixity
|
||||
@ -9,17 +13,17 @@ import Ormolu.Fixity.Internal (LazyFixityMap (..))
|
||||
import Ormolu.Printer.Operators
|
||||
import Test.Hspec
|
||||
|
||||
n :: String -> OpTree String String
|
||||
n :: Text -> OpTree Text OpName
|
||||
n = OpNode
|
||||
|
||||
-- | Check that the input tree is actually reassociated as expected.
|
||||
checkReassociate ::
|
||||
-- | Fixity map used for the reassociation
|
||||
[(String, FixityInfo)] ->
|
||||
[(OpName, FixityInfo)] ->
|
||||
-- | Input tree
|
||||
OpTree String String ->
|
||||
OpTree Text OpName ->
|
||||
-- | Expected output tree
|
||||
OpTree String String ->
|
||||
OpTree Text OpName ->
|
||||
Expectation
|
||||
checkReassociate lFixities inputTree expectedOutputTree =
|
||||
removeOpInfo actualOutputTree `shouldBe` expectedOutputTree
|
||||
@ -29,10 +33,10 @@ checkReassociate lFixities inputTree expectedOutputTree =
|
||||
OpBranches (removeOpInfo <$> exprs) (opiOp <$> ops)
|
||||
actualOutputTree = reassociateOpTree convertName Map.empty fixityMap inputTree
|
||||
fixityMap = LazyFixityMap [Map.fromList lFixities]
|
||||
convertName = Just . mkRdrUnqual . mkOccName varName
|
||||
convertName = Just . mkRdrUnqual . mkOccName varName . T.unpack . unOpName
|
||||
|
||||
-- | Associative list of fixities for operators from "base"
|
||||
baseFixities :: [(String, FixityInfo)]
|
||||
baseFixities :: [(OpName, FixityInfo)]
|
||||
baseFixities = Map.toList . fromJust $ Map.lookup "base" packageToOps
|
||||
|
||||
spec :: Spec
|
||||
|
@ -1,3 +1,4 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
|
||||
module Ormolu.PrinterSpec (spec) where
|
||||
|
Loading…
Reference in New Issue
Block a user