diff --git a/sabela.cabal b/sabela.cabal index 91b20a7..6a40cbe 100644 --- a/sabela.cabal +++ b/sabela.cabal @@ -20,6 +20,8 @@ library import: warnings autogen-modules: Paths_sabela other-modules: Paths_sabela + Sabela.Parse.Ast.PatNodeBinders + Sabela.Parse.Ast.Names exposed-modules: Sabela.Anthropic, Sabela.Anthropic.Types, Sabela.Anthropic.Types.Request, @@ -114,6 +116,10 @@ library time >= 1.9 && < 2, wai >= 3.2 && < 3.3 hs-source-dirs: src + if impl(ghc >= 9.6) + hs-source-dirs: src-ghc96 + else + hs-source-dirs: src-ghc94 default-language: Haskell2010 executable sabela diff --git a/src-ghc94/Sabela/Parse/Ast/PatNodeBinders.hs b/src-ghc94/Sabela/Parse/Ast/PatNodeBinders.hs new file mode 100644 index 0000000..c3b1bde --- /dev/null +++ b/src-ghc94/Sabela/Parse/Ast/PatNodeBinders.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE LambdaCase #-} + +module Sabela.Parse.Ast.PatNodeBinders (patNodeBinders) where + +import Data.Set (Set) +import qualified Data.Set as S +import Data.Text (Text) +import qualified GHC.Hs as Hs +import GHC.Types.SrcLoc (unLoc) +import qualified Language.Haskell.Syntax as Hs +import Sabela.Parse.Ast.Names + +patNodeBinders :: Hs.Pat Hs.GhcPs -> Set Text +patNodeBinders = \case + Hs.VarPat _ ln -> S.singleton (rdrText (unLoc ln)) + Hs.AsPat _ ln _ _ -> S.singleton (rdrText (unLoc ln)) + Hs.NPlusKPat _ ln _ _ _ _ -> S.singleton (rdrText (unLoc ln)) + _ -> S.empty diff --git a/src-ghc96/Sabela/Parse/Ast/PatNodeBinders.hs b/src-ghc96/Sabela/Parse/Ast/PatNodeBinders.hs new file mode 100644 index 0000000..6932139 --- /dev/null +++ b/src-ghc96/Sabela/Parse/Ast/PatNodeBinders.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE LambdaCase #-} + +module Sabela.Parse.Ast.PatNodeBinders (patNodeBinders) where + +import Data.Set (Set) +import qualified Data.Set as S +import Data.Text (Text) +import qualified GHC.Hs as Hs +import GHC.Types.SrcLoc (unLoc) +import qualified Language.Haskell.Syntax as Hs +import Sabela.Parse.Ast.Names + +patNodeBinders :: Hs.Pat Hs.GhcPs -> Set Text +patNodeBinders = \case + Hs.VarPat _ ln -> S.singleton (rdrText (unLoc ln)) + Hs.AsPat _ ln _ -> S.singleton (rdrText (unLoc ln)) + Hs.NPlusKPat _ ln _ _ _ _ -> S.singleton (rdrText (unLoc ln)) + _ -> S.empty diff --git a/src/Sabela/Parse/Ast.hs b/src/Sabela/Parse/Ast.hs index 9743824..97fdce2 100644 --- a/src/Sabela/Parse/Ast.hs +++ b/src/Sabela/Parse/Ast.hs @@ -30,14 +30,13 @@ import qualified Data.List.NonEmpty as NE import Data.Set (Set) import qualified Data.Set as S import Data.Text (Text) -import qualified Data.Text as T import Data.Generics.Uniplate.Data (universeBi) import qualified GHC.Hs as Hs -import GHC.Types.Name.Occurrence (occNameString) -import GHC.Types.Name.Reader (RdrName, rdrNameOcc) import GHC.Types.SrcLoc (unLoc) +import Sabela.Parse.Ast.Names (rdrText) +import qualified Sabela.Parse.Ast.PatNodeBinders as PatNodeBinders -- --------------------------------------------------------------------------- -- Module-level extraction @@ -147,11 +146,7 @@ bumps — sub-patterns are reached generically rather than by hand-coded constructor matching. -} patNodeBinders :: Hs.Pat Hs.GhcPs -> Set Text -patNodeBinders = \case - Hs.VarPat _ ln -> S.singleton (rdrText (unLoc ln)) - Hs.AsPat _ ln _ _ -> S.singleton (rdrText (unLoc ln)) - Hs.NPlusKPat _ ln _ _ _ _ -> S.singleton (rdrText (unLoc ln)) - _ -> S.empty +patNodeBinders = PatNodeBinders.patNodeBinders -- | Recursive pattern-binder extraction (every level of nesting). patBinders :: Hs.Pat Hs.GhcPs -> Set Text @@ -195,11 +190,3 @@ collectBinders x = S.unions [bindersFromBind, bindersFromPat, bindersFromTyCl] [ tyClBinders t | t <- universeBi x :: [Hs.TyClDecl Hs.GhcPs] ] - --- --------------------------------------------------------------------------- --- Names --- --------------------------------------------------------------------------- - --- | Convert an 'RdrName' to its bare @OccName@ as 'Text'. -rdrText :: RdrName -> Text -rdrText = T.pack . occNameString . rdrNameOcc diff --git a/src/Sabela/Parse/Ast/Names.hs b/src/Sabela/Parse/Ast/Names.hs new file mode 100644 index 0000000..359d89a --- /dev/null +++ b/src/Sabela/Parse/Ast/Names.hs @@ -0,0 +1,14 @@ +module Sabela.Parse.Ast.Names (rdrText) where + +import Data.Text (Text) +import qualified Data.Text as T +import GHC.Types.Name.Occurrence (occNameString) +import GHC.Types.Name.Reader (RdrName, rdrNameOcc) + +-- --------------------------------------------------------------------------- +-- Names +-- --------------------------------------------------------------------------- + +-- | Convert an 'RdrName' to its bare @OccName@ as 'Text'. +rdrText :: RdrName -> Text +rdrText = T.pack . occNameString . rdrNameOcc