Skip to content
This repository has been archived by the owner on Aug 27, 2020. It is now read-only.

Merge adjacent SrcSpans (#1) #36

Merged
merged 2 commits into from Oct 7, 2017
Merged

Merge adjacent SrcSpans (#1) #36

Show file tree
Hide file tree
Changes from 1 commit
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
a9cbe81
Merge adjacent SrcSpans (#1)
chshersh Oct 7, 2017
aba0be4
Refactor modules structure regarding Print (#1)
chshersh Oct 7, 2017
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Jump to
Jump to file
Failed to load files.
Diff view
Diff view
46 changes: 41 additions & 5 deletions src/Language/Haskell/HGrep.hs
View file
Open in desktop
Expand Up @@ -25,14 +25,17 @@ module Language.Haskell.HGrep (


import Language.Haskell.HGrep.Internal.Data
import Language.Haskell.HGrep.Prelude
import qualified Language.Haskell.HGrep.Print as HP
import qualified Language.Haskell.HGrep.Query as HQ
import Language.Haskell.HGrep.Prelude

import qualified Language.Haskell.GHC.ExactPrint as EP

import qualified System.IO as IO

import GHC.Num ((+))
Copy link
Owner

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This should have been included in the project Prelude, it's an oversight on my part. Sorry about that.

import qualified SrcLoc


parseModule :: FilePath -> IO (Either ParseError ParsedSource)
parseModule hs =
Expand All @@ -44,8 +47,41 @@ queryModule q src =
(HQ.findTypeDecl q src)
(HQ.findValueDecl q src)

type TextWithLocation = ([Char], SrcLoc.SrcSpan)

printResults :: PrintOpts -> [SearchResult] -> IO ()
printResults opts results =
for_ results $ \res -> do
IO.hPutStr IO.stdout (HP.printSearchResultLocation opts res)
IO.hPutStrLn IO.stdout (HP.printSearchResult opts res)
printResults opts results = do
let printedResult = fmap printWithLocation results
for_ (foldAdjacent printedResult) $ \(textResult, span) -> do
IO.hPutStr IO.stdout (HP.printSearchResultLocation opts span)
IO.hPutStrLn IO.stdout textResult
where
printWithLocation :: SearchResult -> TextWithLocation
printWithLocation result@(SearchResult _ loc) =
(HP.printSearchResult opts result, SrcLoc.getLoc loc)

foldAdjacent :: [TextWithLocation] -> [TextWithLocation]
foldAdjacent [] = []
foldAdjacent [result] = [result]
foldAdjacent (firstResult:secondResult:rest) =
case (firstResult, secondResult) of
((firstText, firstSpan), (secondText, secondSpan)) ->
case mergedLocs firstSpan secondSpan of
Nothing ->
firstResult : foldAdjacent (secondResult:rest)
Just span ->
foldAdjacent $ (firstText <> secondText, span) : rest

mergedLocs :: SrcLoc.SrcSpan -> SrcLoc.SrcSpan -> Maybe SrcLoc.SrcSpan
mergedLocs span1 span2
| areAdjacentSpans span1 span2 = Just $ SrcLoc.combineSrcSpans span1 span2
| otherwise = Nothing

areAdjacentSpans :: SrcLoc.SrcSpan -> SrcLoc.SrcSpan -> Bool
areAdjacentSpans span1 span2 =
areAdjacentLocs (SrcLoc.srcSpanEnd span1) (SrcLoc.srcSpanStart span2)

areAdjacentLocs :: SrcLoc.SrcLoc -> SrcLoc.SrcLoc -> Bool
areAdjacentLocs (SrcLoc.RealSrcLoc loc1) (SrcLoc.RealSrcLoc loc2) =
SrcLoc.srcLocLine loc1 + 1 == SrcLoc.srcLocLine loc2
areAdjacentLocs _ _ = False
8 changes: 4 additions & 4 deletions src/Language/Haskell/HGrep/Print.hs
View file
Open in desktop
Expand Up @@ -8,7 +8,7 @@ module Language.Haskell.HGrep.Print (


import qualified Data.List as L
import qualified Data.Map as Map
import qualified Data.Map as Map

import qualified Language.Haskell.GHC.ExactPrint as EP
import qualified Language.Haskell.GHC.ExactPrint.Types as EP
Expand Down Expand Up @@ -87,9 +87,9 @@ printSearchResult (PrintOpts co lno) (SearchResult anns ast) =
prependLineNum :: Int -> [Char] -> [Char]
prependLineNum i l = show i <> " " <> l

printSearchResultLocation :: PrintOpts -> SearchResult -> [Char]
printSearchResultLocation (PrintOpts co _) (SearchResult _anns ast) =
let loc = chomp (unsafePpr (SrcLoc.getLoc ast)) in
printSearchResultLocation :: PrintOpts -> SrcLoc.SrcSpan -> [Char]
printSearchResultLocation (PrintOpts co _) span =
let loc = chomp (unsafePpr span) in
case co of
DefaultColours ->
ansiLocationFormat <> loc <> ansiReset
Expand Down