diff options
| author | Yuchen Pei <hi@ypei.me> | 2022-08-18 15:34:01 +1000 | 
|---|---|---|
| committer | Yuchen Pei <hi@ypei.me> | 2022-08-18 15:34:01 +1000 | 
| commit | dfba9cfeb5310b4c94436e1b3df64d8bbd60a4eb (patch) | |
| tree | c962d237d05d51026f12423fd30cfdeadc524855 /src/HaskellCodeExplorer | |
| parent | 1272b763ab497a294be77e8a4529f183b3ccaa7b (diff) | |
linting preprocessor and ghcutils
Diffstat (limited to 'src/HaskellCodeExplorer')
| -rw-r--r-- | src/HaskellCodeExplorer/GhcUtils.hs | 94 | ||||
| -rw-r--r-- | src/HaskellCodeExplorer/Preprocessor.hs | 2 | 
2 files changed, 50 insertions, 46 deletions
diff --git a/src/HaskellCodeExplorer/GhcUtils.hs b/src/HaskellCodeExplorer/GhcUtils.hs index 89cd4bc..0801dc0 100644 --- a/src/HaskellCodeExplorer/GhcUtils.hs +++ b/src/HaskellCodeExplorer/GhcUtils.hs @@ -1,4 +1,5 @@  {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE NamedFieldPuns #-}  {-# LANGUAGE TypeApplications #-}  {-# LANGUAGE ViewPatterns #-}  {-# LANGUAGE TupleSections #-} @@ -452,13 +453,12 @@ lookupNameModuleAndPackage    -> HCE.PackageId    -> Name    -> Either T.Text (HCE.HaskellModuleName, HCE.PackageId) -lookupNameModuleAndPackage state currentPackageId name = -  case nameModule_maybe name of +lookupNameModuleAndPackage state currentPackageId@HCE.PackageId { name = pkgIdName } name +  = case nameModule_maybe name of      Just Module {..} -> case lookupUnit state moduleUnit of        Just unitInfo ->          let packageId = -              if (T.pack . unitPackageNameString $ unitInfo) -                   == HCE.name (currentPackageId :: HCE.PackageId) +              if (T.pack . unitPackageNameString $ unitInfo) == pkgIdName                  then currentPackageId                  else HCE.PackageId (T.pack $ unitPackageNameString unitInfo)                                     (unitPackageVersion unitInfo) @@ -534,11 +534,10 @@ moduleLocationInfo unitState moduleNameMap currentPackageId compId moduleName =  isDefinedInCurrentModule    :: HCE.SourceCodeTransformation -> HCE.HaskellFilePath -> Bool -isDefinedInCurrentModule transformation file = -  let includedFiles = HM.keys $ HCE.fileIndex transformation -      modPath       = HCE.getHaskellModulePath -        $ HCE.filePath (transformation :: HCE.SourceCodeTransformation) -  in  HCE.getHaskellFilePath file == modPath || (file `elem` includedFiles) +isDefinedInCurrentModule transformation@HCE.SourceCodeTransformation {..} file +  = let includedFiles = HM.keys $ HCE.fileIndex transformation +        modPath       = HCE.getHaskellModulePath filePath +    in  HCE.getHaskellFilePath file == modPath || (file `elem` includedFiles)  nameLocationInfo    :: UnitState @@ -551,7 +550,7 @@ nameLocationInfo    -> Maybe SrcSpan -- ^ Only for wired-in names    -> Name    -> HCE.LocationInfo -nameLocationInfo unitState currentPackageId compId transformation fileMap defSiteMap mbInstanceHead mbSrcSpan name +nameLocationInfo unitState currentPackageId compId transformation@HCE.SourceCodeTransformation { filePath = modulePath } fileMap defSiteMap mbInstanceHead mbSrcSpan name    | Just srcSpan <- realSrcSpan name mbSrcSpan    = let        filePath = @@ -579,22 +578,21 @@ nameLocationInfo unitState currentPackageId compId transformation fileMap defSit            in              case (,) eitherStart eitherEnd of                (Right startLine, Right endLine) -> -                let -                  modulePath = HCE.filePath -                    (transformation :: HCE.SourceCodeTransformation) -                  moduleName = either -                    (const $ HCE.HaskellModuleName "") -                    fst -                    (lookupNameModuleAndPackage unitState currentPackageId name) -                in -                  HCE.ExactLocation { packageId   = currentPackageId -                                    , modulePath  = modulePath -                                    , moduleName  = moduleName -                                    , startLine   = startLine -                                    , endLine     = endLine -                                    , startColumn = srcSpanStartCol srcSpan -                                    , endColumn   = srcSpanEndCol srcSpan -                                    } +                let moduleName = either +                      (const $ HCE.HaskellModuleName "") +                      fst +                      (lookupNameModuleAndPackage unitState +                                                  currentPackageId +                                                  name +                      ) +                in  HCE.ExactLocation { packageId   = currentPackageId +                                      , modulePath  = modulePath +                                      , moduleName  = moduleName +                                      , startLine   = startLine +                                      , endLine     = endLine +                                      , startColumn = srcSpanStartCol srcSpan +                                      , endColumn   = srcSpanEndCol srcSpan +                                      }                _ -> approximateLocation          else case HM.lookup filePath fileMap of            Just haskellModulePath -> @@ -675,22 +673,28 @@ occNameLocationInfo flags packageId componentId (modName, occName) =  lookupEntityLocation    :: HCE.DefinitionSiteMap -> HCE.LocatableEntity -> T.Text -> HCE.LocationInfo  lookupEntityLocation defSiteMap locatableEntity text = -  let errorMessage = T.concat -        ["Cannot find location of ", T.pack . show $ locatableEntity, " ", text] -      defSiteLocation = HCE.location :: HCE.DefinitionSite -> HCE.LocationInfo -      lookupLocation -        :: (Eq a, Hashable a) -        => (HCE.DefinitionSiteMap -> HM.HashMap a HCE.DefinitionSite) -        -> (T.Text -> a) -        -> HCE.LocationInfo -      lookupLocation selector toKey = -        maybe (HCE.UnknownLocation errorMessage) defSiteLocation -          $ HM.lookup (toKey text) (selector defSiteMap) -  in  case locatableEntity of -        HCE.Val  -> lookupLocation HCE.values HCE.OccName -        HCE.Typ  -> lookupLocation HCE.types HCE.OccName -        HCE.Inst -> lookupLocation HCE.instances (\t -> t) -        HCE.Mod  -> HCE.UnknownLocation errorMessage +  let +    errorMessage = T.concat +      ["Cannot find location of ", T.pack . show $ locatableEntity, " ", text] +    defSiteLocation HCE.DefinitionSite {..} = location +    lookupLocation +      :: (Eq a, Hashable a) +      => (HCE.DefinitionSiteMap -> HM.HashMap a HCE.DefinitionSite) +      -> (T.Text -> a) +      -> HCE.LocationInfo +    lookupLocation selector toKey = +      maybe (HCE.UnknownLocation errorMessage) defSiteLocation +        $ HM.lookup (toKey text) (selector defSiteMap) +  in +    case locatableEntity of +      HCE.Val -> +        lookupLocation (\HCE.DefinitionSiteMap { values } -> values) HCE.OccName +      HCE.Typ -> +        lookupLocation (\HCE.DefinitionSiteMap { types } -> types) HCE.OccName +      HCE.Inst -> lookupLocation +        (\HCE.DefinitionSiteMap { instances } -> instances) +        (\t -> t) +      HCE.Mod -> HCE.UnknownLocation errorMessage  nameDocumentation    :: HCE.SourceCodeTransformation @@ -720,9 +724,9 @@ lookupNameDocumentation name defSiteMap =        lookupDoc selector = maybe Nothing HCE.documentation          $ HM.lookup key (selector (defSiteMap :: HCE.DefinitionSiteMap))    in  case occNameNameSpace . nameOccName $ name of -        HCE.VarName  -> lookupDoc HCE.values -        HCE.DataName -> lookupDoc HCE.values -        _            -> lookupDoc HCE.types +        HCE.VarName  -> lookupDoc (\HCE.DefinitionSiteMap { values } -> values) +        HCE.DataName -> lookupDoc (\HCE.DefinitionSiteMap { values } -> values) +        _            -> lookupDoc (\HCE.DefinitionSiteMap { types } -> types)  srcSpanToFilePath :: SrcSpan -> Maybe HCE.HaskellFilePath  srcSpanToFilePath (RealSrcSpan s _) = diff --git a/src/HaskellCodeExplorer/Preprocessor.hs b/src/HaskellCodeExplorer/Preprocessor.hs index abea661..eb832ce 100644 --- a/src/HaskellCodeExplorer/Preprocessor.hs +++ b/src/HaskellCodeExplorer/Preprocessor.hs @@ -49,7 +49,7 @@ createSourceCodeTransformation currentModulePath originalSourceCode sourceCodeAf            Left _ -> acc        totalLines = length numberedLines        pragmas    = L.reverse . L.foldl' addPragma [] $ numberedLines -      pragmaPath = filePath :: LinePragma -> HaskellFilePath +      pragmaPath LinePragma {..} = filePath        currentFileExtension =          takeExtension . T.unpack . getHaskellFilePath $ currentFilePath        standardHeaderFiles =  | 
