diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,3 @@ +## Version 0.0 (2017-10-03) + +- Initial release diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,29 @@ +Copyright 2017, Tim Humphries +All Rights Reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + + 3. Neither the name of the copyright holder nor the names of + its contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,37 @@ +# hgrep + +Search Haskell source code from the command line. + +Powered by ghc-exactprint. + +## Usage + +`hgrep` requires an expression and a set of files to search across to +function. For now, an expression can only be the full name of a type +or an expression. + +``` +$> hgrep +Usage: hgrep EXPRESSION [FILE] +``` + +``` +$> hgrep main main/hgrep.hs +main/hgrep.hs:16:1-13 + +-- | Run the program. +main :: IO () +main/hgrep.hs:(17,1)-(18:27) + +main = do + putStrLn "Hello, world!" +``` + +``` +$> hgrep PrintOpts src/**/*.hs +src/Language/Haskell/HGrep/Internal/Data.hs:(40,1)-(42,28) + +data PrintOpts = PrintOpts { + poColourOpts :: ColourOpts + } deriving (Eq, Ord, Show) +``` diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/hgrep.cabal b/hgrep.cabal new file mode 100644 --- /dev/null +++ b/hgrep.cabal @@ -0,0 +1,62 @@ +name: hgrep +version: 0.0 +homepage: https://github.com/thumphries/hgrep +author: Tim Humphries +maintainer: tim@utf8.me +bug-reports: https://github.com/thumphries/hgrep +license: BSD3 +license-file: LICENSE +category: Language +build-type: Simple +cabal-version: >=1.10 +tested-with: GHC == 8.0.2 +extra-source-files: + README.md + CHANGELOG.md + +synopsis: + Search Haskell source code from the command line +description: + Search Haskell source code from the command line. + . + Powered by . + +source-repository head + type: git + location: git://github.com/thumphries/hgrep.git + +executable hgrep + default-language: Haskell2010 + hs-source-dirs: main + ghc-options: -Wall -threaded -rtsopts + main-is: hgrep.hs + build-depends: + base >= 4.9 && < 4.11 + , hgrep + , ansi-terminal >= 0.6.3 && < 0.8 + , optparse-applicative >= 0.13 && < 0.15 + +library + default-language: Haskell2010 + hs-source-dirs: src + ghc-options: -Wall + build-depends: + base >= 4.9 && < 4.11 + , ansi-terminal >= 0.6.3 && < 0.8 + , ghc >= 7.10.2 && < 8.3 + , ghc-exactprint >= 0.5 && < 0.6 + , hscolour >= 1.24 && < 1.25 + , lens >= 4.15 && < 4.16 + , template-haskell >= 2.11 && < 2.13 + , transformers >= 0.5 && < 0.7 + , transformers-bifunctors >= 0.1 && < 1.0 + + exposed-modules: + Language.Haskell.HGrep + Language.Haskell.HGrep.Query + Language.Haskell.HGrep.Prelude + Language.Haskell.HGrep.Print + + Language.Haskell.HGrep.Internal.Data + Language.Haskell.HGrep.Internal.Lens + Language.Haskell.HGrep.Internal.Lens.Rules diff --git a/main/hgrep.hs b/main/hgrep.hs new file mode 100644 --- /dev/null +++ b/main/hgrep.hs @@ -0,0 +1,74 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +module Main where + + +import qualified Language.Haskell.HGrep as HGrep +import Language.Haskell.HGrep.Prelude + +import qualified Options.Applicative as O + +import qualified System.Console.ANSI as ANSI +import System.Exit (ExitCode (..), exitWith) +import qualified System.IO as IO + + +main :: IO () +main = do + IO.hSetBuffering IO.stdout IO.LineBuffering + IO.hSetBuffering IO.stderr IO.LineBuffering + opts <- parseOpts + colour <- detectColour + found <- + fmap sum $ + for (cmdFiles opts) $ \fp -> + hgrep (HGrep.PrintOpts colour) (cmdQuery opts) fp + exitWith (exitCode found) + +exitCode :: Integer -> ExitCode +exitCode found + | found == 0 = ExitFailure 1 + | otherwise = ExitSuccess + +detectColour :: IO HGrep.ColourOpts +detectColour = do + out <- ANSI.hSupportsANSI IO.stdout + err <- ANSI.hSupportsANSI IO.stderr + pure $ case out && err of + True -> + HGrep.DefaultColours + False -> + HGrep.NoColours + +hgrep :: HGrep.PrintOpts -> HGrep.Query -> FilePath -> IO Integer +hgrep popts q fp = do + esrc <- HGrep.parseModule fp + case esrc of + Left err -> + -- FIXME report or count errors + pure 0 + + Right src -> do + let results = HGrep.queryModule q src + HGrep.printResults popts results + pure $ fromIntegral (length results) + +-- ----------------------------------------------------------------------------- + +data CmdOpts = CmdOpts { + cmdQuery :: [Char] + , cmdFiles :: [FilePath] + } deriving (Eq, Ord, Show) + +parseOpts :: IO CmdOpts +parseOpts = + O.execParser $ + O.info + (parser <**> O.helper) + (O.header "hgrep - search Haskell source code from the command line") + +parser :: O.Parser CmdOpts +parser = + CmdOpts + <$> O.argument O.str (O.metavar "QUERY") + <*> many (O.argument O.str (O.metavar "FILE")) diff --git a/src/Language/Haskell/HGrep.hs b/src/Language/Haskell/HGrep.hs new file mode 100644 --- /dev/null +++ b/src/Language/Haskell/HGrep.hs @@ -0,0 +1,45 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +module Language.Haskell.HGrep ( + -- * Parsing + ParsedSource + , parseModule + -- * Searching + , Query + , SearchResult + , queryModule + -- * Printing + , PrintOpts (..) + , defaultPrintOpts + , ColourOpts (..) + , printResults + , HP.printSearchResult + , HP.printSearchResultLocation + ) where + + +import Language.Haskell.HGrep.Internal.Data +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 + + +parseModule :: FilePath -> IO (Either ParseError ParsedSource) +parseModule hs = + bimap ParseError ParsedSource <$> EP.parseModule hs + +queryModule :: Query -> ParsedSource -> [SearchResult] +queryModule q src = + (<>) + (HQ.findTypeDecl q src) + (HQ.findValueDecl q src) + +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) diff --git a/src/Language/Haskell/HGrep/Internal/Data.hs b/src/Language/Haskell/HGrep/Internal/Data.hs new file mode 100644 --- /dev/null +++ b/src/Language/Haskell/HGrep/Internal/Data.hs @@ -0,0 +1,53 @@ +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} +module Language.Haskell.HGrep.Internal.Data ( + ParsedSource (..) + , ParseError (..) + , Query + , SearchResult (..) + , PrintOpts (..) + , defaultPrintOpts + , ColourOpts (..) + ) where + + +import Language.Haskell.HGrep.Prelude + +import qualified Language.Haskell.GHC.ExactPrint.Annotater as EA +import qualified Language.Haskell.GHC.ExactPrint.Types as ET + +import qualified GHC +import qualified SrcLoc + + +newtype ParsedSource = ParsedSource { + unParsedSource :: (ET.Anns, GHC.Located (GHC.HsModule GHC.RdrName)) + } + +newtype ParseError = ParseError { + unParseError :: (SrcLoc.SrcSpan, [Char]) + } + +type Query = [Char] + +data SearchResult = + forall ast. EA.Annotate ast => + SearchResult ET.Anns (SrcLoc.Located ast) + +data PrintOpts = PrintOpts { + poColourOpts :: ColourOpts + } deriving (Eq, Ord, Show) + +data ColourOpts = + DefaultColours + | NoColours + deriving (Eq, Ord, Show) + +defaultPrintOpts :: PrintOpts +defaultPrintOpts = + PrintOpts { + poColourOpts = DefaultColours + } diff --git a/src/Language/Haskell/HGrep/Internal/Lens.hs b/src/Language/Haskell/HGrep/Internal/Lens.hs new file mode 100644 --- /dev/null +++ b/src/Language/Haskell/HGrep/Internal/Lens.hs @@ -0,0 +1,65 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE UndecidableInstances #-} +module Language.Haskell.HGrep.Internal.Lens where + + +import Control.Lens + +import Language.Haskell.HGrep.Internal.Lens.Rules (makeOptics) +import Language.Haskell.HGrep.Prelude + +import HsBinds +import HsDecls +import HsExpr +import HsLit +import HsSyn +import OccName +import RdrName +import SrcLoc + + +makeOptics ''GenLocated + +_loc :: Lens' (Located e) SrcSpan +_loc = _L . _1 + +_unloc :: Lens' (Located e) e +_unloc = _L . _2 + +makeOptics ''OccName +makeOptics ''RdrName + +makeOptics ''HsModule + +makeOptics ''HsDecl +makeOptics ''TyClDecl +makeOptics ''InstDecl +makeOptics ''DerivDecl +makeOptics ''Sig +makeOptics ''DefaultDecl +makeOptics ''ForeignDecl +makeOptics ''WarnDecls +makeOptics ''AnnDecl +makeOptics ''RuleDecls +makeOptics ''VectDecl +makeOptics ''SpliceDecl +makeOptics ''DocDecl +makeOptics ''RoleAnnotDecl + +makeOptics ''HsBindLR + +makeOptics ''HsExpr +makeOptics ''SyntaxExpr +makeOptics ''MatchGroup +makeOptics ''StmtLR + +makeOptics ''HsLit + +makeOptics ''HsType diff --git a/src/Language/Haskell/HGrep/Internal/Lens/Rules.hs b/src/Language/Haskell/HGrep/Internal/Lens/Rules.hs new file mode 100644 --- /dev/null +++ b/src/Language/Haskell/HGrep/Internal/Lens/Rules.hs @@ -0,0 +1,29 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +module Language.Haskell.HGrep.Internal.Lens.Rules where + + +import Control.Lens + +import Language.Haskell.HGrep.Prelude + +import Language.Haskell.TH (Name, DecsQ, mkName, nameBase) + + +rules :: LensRules +rules = + lensRules + & set' lensField namer + & set' simpleLenses False + & set' createClass False + & set' generateSignatures True + +namer :: FieldNamer +namer _tn _fields field = + [TopName (mkName ("_" <> nameBase field))] + +makeOptics :: Name -> DecsQ +makeOptics tn = + (<>) + <$> makeLensesWith rules tn + <*> makePrisms tn diff --git a/src/Language/Haskell/HGrep/Prelude.hs b/src/Language/Haskell/HGrep/Prelude.hs new file mode 100644 --- /dev/null +++ b/src/Language/Haskell/HGrep/Prelude.hs @@ -0,0 +1,361 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternSynonyms #-} +module Language.Haskell.HGrep.Prelude ( + -- * Primitive types + -- ** Bool + Bool (..) + , bool + , (&&) + , (||) + , not + , otherwise + -- ** Char + , Char + -- ** Int + , Integer + , Int + , Int8 + , Int16 + , Int32 + , Int64 + -- ** Word + , Word64 + -- ** Real + , fromIntegral + , fromRational + + -- * Algebraic structures + -- ** Monoid + , Monoid (..) + , (<>) + -- ** Functor + , Functor (..) + , (<$>) + , ($>) + , void + , with + -- ** Bifunctor + , Bifunctor (..) + -- ** Applicative + , Applicative (..) + , (<**>) + -- ** Alternative + , Alternative (..) + , asum + -- ** Monad + , Monad (..) + , join + -- ** MonadPlus + , MonadPlus (..) + , guard + , msum + -- ** MonadTrans + , MonadTrans (..) + -- ** BifunctorTrans + , BifunctorTrans (..) + -- ** MonadIO + , MonadIO (..) + + -- * Data structures + -- ** Either + , Either (..) + , either + , note + -- *** EitherT + , EitherT + , pattern EitherT + , runEitherT + , left + , right + -- ** Maybe + , Maybe (..) + , fromMaybe + , maybe + , hush + -- *** MaybeT + , MaybeT (..) + , nothing + -- ** Tuple + , fst + , snd + , curry + , uncurry + + -- * Typeclasses + -- ** Enum + , Enum (..) + -- ** Eq + , Eq (..) + -- ** Read + , Read (..) + , readEither + , readMaybe + -- ** Show + , Show (..) + -- *** ShowS + , ShowS + , showString + -- ** Foldable + , Foldable (..) + , for_ + -- ** Ord + , Ord (..) + , Ordering (..) + , comparing + -- ** Traversable + , Traversable (..) + , for + , traverse_ + + + -- * Combinators + , id + , (.) + , ($) + , ($!) + , (&) + , const + , flip + , fix + , on + , seq + + -- * System + -- ** IO + , IO + , FilePath + + -- * Partial functions + , undefined + , error + + -- * Debugging facilities + , trace + , traceM + , traceIO + ) where + + +import Control.Monad as Monad ( + Monad (..) + , MonadPlus (..) + , guard + , join + , msum + ) +import Control.Monad.IO.Class ( + MonadIO (..) + ) +import Control.Monad.Trans.Bifunctor as BifunctorTrans ( + BifunctorTrans (..) + ) +import Control.Monad.Trans.Class as MonadTrans ( + MonadTrans (..) + ) +import Control.Monad.Trans.Except as ExceptT ( + ExceptT (..) + , runExceptT + , throwE + ) +import Control.Monad.Trans.Maybe as MaybeT ( + MaybeT (..) + ) +import Control.Applicative as Applicative ( + Applicative (..) + , (<**>) + , Alternative (..) + , empty + ) + +import Data.Bifunctor as Bifunctor ( + Bifunctor (..) + ) +import Data.Bool as Bool ( + Bool (..) + , bool + , (&&) + , (||) + , not + , otherwise + ) +import Data.Char as Char ( + Char + ) +import Data.Either as Either ( + Either (..) + , either + ) +import Data.Foldable as Foldable ( + Foldable (..) + , asum + , traverse_ + , for_ + ) +import Data.Function as Function ( + id + , (.) + , ($) + , (&) + , const + , flip + , fix + , on + ) +import Data.Functor as Functor ( + Functor (..) + , (<$>) + , ($>) + , void + ) +import Data.Eq as Eq ( + Eq (..) + ) +import Data.Int as Int ( + Int + , Int8 + , Int16 + , Int32 + , Int64 + ) +import Data.Maybe as Maybe ( + Maybe (..) + , fromMaybe + , maybe + ) +import Data.Monoid as Monoid ( + Monoid (..) + , (<>) + ) +import Data.Ord as Ord ( + Ord (..) + , Ordering (..) + , comparing + ) +import Data.Traversable as Traversable ( + Traversable (..) + , for + ) +import Data.Tuple as Tuple ( + fst + , snd + , curry + , uncurry + ) +import Data.Word as Word ( + Word64 + ) + +import qualified Debug.Trace as Trace + +import GHC.Real as Real ( + fromIntegral + , fromRational + ) +#if MIN_VERSION_base(4,9,0) +import GHC.Stack (HasCallStack) +#endif + +import Prelude as Prelude ( + Enum (..) + , Integer + , seq + , ($!) + ) +import qualified Prelude as Unsafe + +import System.IO as IO ( + FilePath + , IO + ) + +import Text.Read as Read ( + Read (..) + , readEither + , readMaybe + ) +import Text.Show as Show ( + Show (..) + , ShowS + , showString + ) + + +#if MIN_VERSION_base(4,9,0) +undefined :: HasCallStack => a +#else +undefined :: a +#endif +undefined = + Unsafe.undefined +{-# WARNING undefined "'undefined' is unsafe" #-} + +#if MIN_VERSION_base(4,9,0) +error :: HasCallStack => [Char] -> a +#else +error :: [Char] -> a +#endif +error = + Unsafe.error +{-# WARNING error "'error' is unsafe" #-} + +trace :: [Char] -> a -> a +trace = + Trace.trace +{-# WARNING trace "'trace' should only be used while debugging" #-} + +#if MIN_VERSION_base(4,9,0) +traceM :: Applicative f => [Char] -> f () +#else +traceM :: Monad m => [Char] -> m () +#endif +traceM = + Trace.traceM +{-# WARNING traceM "'traceM' should only be used while debugging" #-} + +traceIO :: [Char] -> IO () +traceIO = + Trace.traceIO +{-# WARNING traceIO "'traceIO' should only be used while debugging" #-} + +with :: Functor f => f a -> (a -> b) -> f b +with = + flip fmap +{-# INLINE with #-} + +-- | Tag a 'Nothing'. +note :: a -> Maybe b -> Either a b +note a Nothing = Left a +note _ (Just b) = Right b +{-# INLINEABLE note #-} + +-- | Eliminate a 'Left'. +hush :: Either a b -> Maybe b +hush (Left _) = Nothing +hush (Right b) = Just b +{-# INLINEABLE hush #-} + +type EitherT = ExceptT +pattern EitherT :: m (Either e a) -> ExceptT e m a +pattern EitherT m = ExceptT m + +runEitherT :: EitherT e m a -> m (Either e a) +runEitherT = + ExceptT.runExceptT +{-# INLINE runEitherT #-} + +left :: Monad m => x -> EitherT x m a +left = + throwE +{-# INLINE left #-} + +right :: Monad m => a -> EitherT x m a +right = + return +{-# INLINE right #-} + +nothing :: Monad m => MaybeT m a +nothing = + MaybeT (return Nothing) +{-# INLINE nothing #-} diff --git a/src/Language/Haskell/HGrep/Print.hs b/src/Language/Haskell/HGrep/Print.hs new file mode 100644 --- /dev/null +++ b/src/Language/Haskell/HGrep/Print.hs @@ -0,0 +1,63 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +module Language.Haskell.HGrep.Print ( + printSearchResult + , printSearchResultLocation + ) where + + +import qualified Data.List as L + +import qualified Language.Haskell.GHC.ExactPrint as EP +import qualified Language.Haskell.HsColour as HsColour +import qualified Language.Haskell.HsColour.Colourise as HsColour + +import Language.Haskell.HGrep.Internal.Data +import Language.Haskell.HGrep.Prelude + +import qualified System.Console.ANSI as ANSI + +import qualified Outputable +import qualified SrcLoc + + +printSearchResult :: PrintOpts -> SearchResult -> [Char] +printSearchResult (PrintOpts co) (SearchResult anns ast) = + let src = EP.exactPrint ast anns in + case co of + DefaultColours -> + hscolour src + NoColours -> + src + +printSearchResultLocation :: PrintOpts -> SearchResult -> [Char] +printSearchResultLocation (PrintOpts co) (SearchResult _anns ast) = + let loc = chomp (unsafePpr (SrcLoc.getLoc ast)) in + case co of + DefaultColours -> + ansiLocationFormat <> loc <> ansiReset + NoColours -> + loc + +ansiLocationFormat :: [Char] +ansiLocationFormat = + ANSI.setSGRCode [ + ANSI.SetColor ANSI.Foreground ANSI.Vivid ANSI.Green + , ANSI.SetUnderlining ANSI.SingleUnderline + ] + +ansiReset :: [Char] +ansiReset = + ANSI.setSGRCode [] + +hscolour :: [Char] -> [Char] +hscolour = + HsColour.hscolour HsColour.TTY HsColour.defaultColourPrefs False False "" False + +unsafePpr :: Outputable.Outputable o => o -> [Char] +unsafePpr = + Outputable.showSDocUnsafe . Outputable.ppr + +chomp :: [Char] -> [Char] +chomp = + L.unlines . L.lines diff --git a/src/Language/Haskell/HGrep/Query.hs b/src/Language/Haskell/HGrep/Query.hs new file mode 100644 --- /dev/null +++ b/src/Language/Haskell/HGrep/Query.hs @@ -0,0 +1,65 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} +module Language.Haskell.HGrep.Query ( + findTypeDecl + , findValueDecl + ) where + + +import Control.Lens + +import Data.Foldable (any) +import qualified Data.List as L +import Data.Maybe (fromMaybe) +import Data.Monoid (First) + +import Language.Haskell.HGrep.Internal.Data +import Language.Haskell.HGrep.Internal.Lens +import Language.Haskell.HGrep.Prelude + +import qualified FastString +import qualified HsDecls +import qualified OccName +import qualified RdrName +import SrcLoc (unLoc) + + +findTypeDecl :: [Char] -> ParsedSource -> [SearchResult] +findTypeDecl name src = + matchDecls src $ \decl -> + fromMaybe False . match decl $ + _TyClD . _DataDecl . _1 . _unloc . to (compareName name) + <> _TyClD . _SynDecl . _1 . _unloc . to (compareName name) + +findValueDecl :: [Char] -> ParsedSource -> [SearchResult] +findValueDecl name src = + matchDecls src $ \decl -> + fromMaybe False . match decl $ + _ValD . _FunBind . _1 . _unloc . to (compareName name) + <> _ValD . _VarBind . _1 . to (compareName name) + <> _SigD . _TypeSig . _1 . to (any (compareName name . unLoc)) + +matchDecls :: ParsedSource -> (HsDecls.HsDecl RdrName.RdrName -> Bool) -> [SearchResult] +matchDecls (ParsedSource (anns, locMod)) p = + fmap (SearchResult anns) $ + L.filter (p . unLoc) (locMod ^. _unloc . _hsmodDecls) + +compareName :: [Char] -> RdrName.RdrName -> Bool +compareName name n = + case n of + RdrName.Unqual ocn -> + fastEq name (OccName.occNameFS ocn) + RdrName.Qual _ ocn -> + fastEq name (OccName.occNameFS ocn) + _ -> + False + +fastEq :: [Char] -> FastString.FastString -> Bool +fastEq s fs = + FastString.mkFastString s == fs + +match :: s -> Getting (First a) s a -> Maybe a +match = + flip preview +{-# INLINE match #-}