<commit_before>{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
module HGrep.GHC where


import           Control.Lens

import qualified Data.List as L
import           Data.Maybe (catMaybes)
import           Data.Monoid (First)

import           HGrep.Data
import           HGrep.Lens
import           HGrep.Prelude

import qualified Language.Haskell.GHC.ExactPrint as EP
import qualified Language.Haskell.HsColour as HsColour
import qualified Language.Haskell.HsColour.Colourise as HsColour

import qualified FastString
import qualified OccName
import qualified RdrName


findTypeDecl :: [Char] -> ParsedSource -> [SearchResult]
findTypeDecl name (ParsedSource (anns, locMod)) =
  let
    decls = locMod ^. _unloc . _hsmodDecls
  in
    fmap (SearchResult anns) . catMaybes . with decls $ \ldec ->
      sequenceA . with ldec $ \dec -> do
        n <- match dec [
            _TyClD . _DataDecl . _1 . _unloc
          , _TyClD . _SynDecl  . _1 . _unloc
          ]
        guard (compareName name n)
        pure dec

findValueDecl :: [Char] -> ParsedSource -> [SearchResult]
findValueDecl name (ParsedSource (anns, locMod)) =
  let
    decls = locMod ^. _unloc . _hsmodDecls
  in
    fmap (SearchResult anns) . catMaybes . with decls $ \ldec ->
      sequenceA . with ldec $ \dec -> do
        n <- match dec [
            _ValD . _FunBind . _1 . _unloc
          , _ValD . _VarBind . _1
-- FIXME list of names here
--          , _SigD . _TypeSig . _1
          ]
        guard (compareName name n)
        pure dec

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


printSearchResult :: SearchResult -> [Char]
printSearchResult (SearchResult anns ast) =
  L.unlines [
      show (ast ^. _loc)
    , hscolour (EP.exactPrint ast anns)
    ]

unOccName :: OccName.OccName -> [Char]
unOccName ocn =
  FastString.unpackFS (OccName.occNameFS ocn)

fastEq :: [Char] -> FastString.FastString -> Bool
fastEq s fs =
  FastString.mkFastString s == fs

match :: Foldable t => s -> t (Getting (First a) s a) -> Maybe a
match a ps =
  preview (fold ps) a

hscolour :: [Char] -> [Char]
hscolour =
  HsColour.hscolour HsColour.TTY HsColour.defaultColourPrefs False False "" False<commit_msg>Print locations<commit_after>{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
module HGrep.GHC where


import           Control.Lens

import qualified Data.List as L
import           Data.Maybe (catMaybes)
import           Data.Monoid (First)

import           HGrep.Data
import           HGrep.Lens
import           HGrep.Prelude

import qualified Language.Haskell.GHC.ExactPrint as EP
import qualified Language.Haskell.HsColour as HsColour
import qualified Language.Haskell.HsColour.Colourise as HsColour

import qualified FastString
import qualified OccName
import qualified Outputable
import qualified RdrName


findTypeDecl :: [Char] -> ParsedSource -> [SearchResult]
findTypeDecl name (ParsedSource (anns, locMod)) =
  let
    decls = locMod ^. _unloc . _hsmodDecls
  in
    fmap (SearchResult anns) . catMaybes . with decls $ \ldec ->
      sequenceA . with ldec $ \dec -> do
        n <- match dec [
            _TyClD . _DataDecl . _1 . _unloc
          , _TyClD . _SynDecl  . _1 . _unloc
          ]
        guard (compareName name n)
        pure dec

findValueDecl :: [Char] -> ParsedSource -> [SearchResult]
findValueDecl name (ParsedSource (anns, locMod)) =
  let
    decls = locMod ^. _unloc . _hsmodDecls
  in
    fmap (SearchResult anns) . catMaybes . with decls $ \ldec ->
      sequenceA . with ldec $ \dec -> do
        n <- match dec [
            _ValD . _FunBind . _1 . _unloc
          , _ValD . _VarBind . _1
-- FIXME list of names here
--          , _SigD . _TypeSig . _1
          ]
        guard (compareName name n)
        pure dec

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


printSearchResult :: SearchResult -> [Char]
printSearchResult (SearchResult anns ast) =
  L.concat [
      unsafePpr (ast ^. _loc)
    , hscolour (EP.exactPrint ast anns)
    ]

unOccName :: OccName.OccName -> [Char]
unOccName ocn =
  FastString.unpackFS (OccName.occNameFS ocn)

fastEq :: [Char] -> FastString.FastString -> Bool
fastEq s fs =
  FastString.mkFastString s == fs

match :: Foldable t => s -> t (Getting (First a) s a) -> Maybe a
match a ps =
  preview (fold ps) a

hscolour :: [Char] -> [Char]
hscolour =
  HsColour.hscolour HsColour.TTY HsColour.defaultColourPrefs False False "" False

unsafePpr :: Outputable.Outputable o => o -> [Char]
unsafePpr =
  Outputable.showSDocUnsafe . Outputable.ppr
{'fraction_non_alphanumeric': 0.09638798701298701, 'fraction_numerical': 0.002029220779220779, 'mean_word_length': 2.47112676056338, 'pattern_counts': {'":': 0, '<': 7, '<?xml version=': 0, '>': 47, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '1826160', 'n_tokens_mistral': 1705, 'n_tokens_neox': 1662, 'n_words': 473}