Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
6 changes: 6 additions & 0 deletions sabela.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -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,
Expand Down Expand Up @@ -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
Expand Down
18 changes: 18 additions & 0 deletions src-ghc94/Sabela/Parse/Ast/PatNodeBinders.hs
Original file line number Diff line number Diff line change
@@ -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
18 changes: 18 additions & 0 deletions src-ghc96/Sabela/Parse/Ast/PatNodeBinders.hs
Original file line number Diff line number Diff line change
@@ -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
19 changes: 3 additions & 16 deletions src/Sabela/Parse/Ast.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
14 changes: 14 additions & 0 deletions src/Sabela/Parse/Ast/Names.hs
Original file line number Diff line number Diff line change
@@ -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
Loading