Fix patNodeBinders again with CPP

Author: turion

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

src-ghc94/Sabela/Parse/Ast/PatNodeBinders.hs

@@ -0,0 +1,17 @@
+{-# LANGUAGE LambdaCase #-}
+module Sabela.Parse.Ast.PatNodeBinders (patNodeBinders) where
+
+import Sabela.Parse.Ast.Names
+import qualified Language.Haskell.Syntax as Hs
+import qualified Data.Set as S
+import GHC.Types.SrcLoc (unLoc)
+import qualified GHC.Hs as Hs
+import Data.Set (Set)
+import Data.Text (Text)
+
+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

src-ghc96/Sabela/Parse/Ast/PatNodeBinders.hs

@@ -0,0 +1,17 @@
+{-# LANGUAGE LambdaCase #-}
+module Sabela.Parse.Ast.PatNodeBinders (patNodeBinders) where
+
+import Sabela.Parse.Ast.Names
+import qualified Language.Haskell.Syntax as Hs
+import qualified Data.Set as S
+import GHC.Types.SrcLoc (unLoc)
+import qualified GHC.Hs as Hs
+import Data.Set (Set)
+import Data.Text (Text)
+
+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

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

src/Sabela/Parse/Ast/Names.hs

@@ -0,0 +1,15 @@
+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