this interface is beautiful

semantic-python/src/Language/Python/ScopeGraph.hs

@@ -2,8 +2,10 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE RankNTypes #-}
@@ -11,15 +13,19 @@
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module Language.Python.ScopeGraph
   ( scopeGraphModule
   ) where
 
+import           Control.Algebra (Algebra (..), handleCoercible)
 import           Control.Effect.Sketch
 import           Convert.ToScopeGraph (Result (..), complete, todo)
 import           Data.Foldable
 import qualified Data.List.NonEmpty as NonEmpty
+import           Data.Monoid
 import           Data.Name
 import           Data.Typeable
 import           GHC.Generics
@@ -29,6 +35,10 @@ import           Language.Python.Patterns
 import           Source.Loc
 import qualified TreeSitter.Python.AST as Py
 
+-- This orphan instance will perish once it lands in fused-effects.
+instance Algebra sig m => Algebra sig (Ap m) where
+  alg = Ap . alg . handleCoercible
+
 -- This typeclass is internal-only, though it shares the same interface
 -- as the one defined in semantic-scope-graph.
 class Typeable t => ToScopeGraph t where
@@ -36,7 +46,7 @@ class Typeable t => ToScopeGraph t where
     ( Has (Sketch Name) sig m
     )
     => t Loc
-    -> m Result
+    -> Ap m Result
 
 instance (ToScopeGraph l, ToScopeGraph r) => ToScopeGraph (l :+: r) where
   scopeGraph (L1 l) = scopeGraph l
@@ -49,7 +59,7 @@ onField ::
   , ToScopeGraph syn
   )
   => r Loc
-  -> m Result
+  -> Ap m Result
 onField
   = scopeGraph @syn
   . getField @field
@@ -61,14 +71,14 @@ onChildren ::
   , HasField "extraChildren" (r Loc) (t (syn Loc))
   )
   => r Loc
-  -> m Result
+  -> Ap m Result
 onChildren
   = fmap fold
   . traverse scopeGraph
   . getField @"extraChildren"
 
 scopeGraphModule :: Has (Sketch Name) sig m => Py.Module Loc -> m Result
-scopeGraphModule = scopeGraph
+scopeGraphModule = getAp . scopeGraph
 
 instance ToScopeGraph Py.AssertStatement where scopeGraph = onChildren
 
@@ -80,10 +90,10 @@ instance ToScopeGraph Py.Await where
   scopeGraph (Py.Await _ a) = scopeGraph a
 
 instance ToScopeGraph Py.BooleanOperator where
-  scopeGraph (Py.BooleanOperator _ _ left right) = mappend <$> scopeGraph left <*> scopeGraph right
+  scopeGraph (Py.BooleanOperator _ _ left right) = scopeGraph left <> scopeGraph right
 
 instance ToScopeGraph Py.BinaryOperator where
-  scopeGraph (Py.BinaryOperator _ _ left right) = mappend <$> scopeGraph left <*> scopeGraph right
+  scopeGraph (Py.BinaryOperator _ _ left right) = scopeGraph left <> scopeGraph right
 
 instance ToScopeGraph Py.AugmentedAssignment where scopeGraph = onField @"right"
 
@@ -91,25 +101,25 @@ instance ToScopeGraph Py.Attribute where scopeGraph = todo
 
 instance ToScopeGraph Py.Block where scopeGraph = onChildren
 
-instance ToScopeGraph Py.BreakStatement where scopeGraph = const (pure mempty)
+instance ToScopeGraph Py.BreakStatement where scopeGraph _ = mempty
 
 instance ToScopeGraph Py.Call where scopeGraph = todo
 
 instance ToScopeGraph Py.ClassDefinition where scopeGraph = todo
 
-instance ToScopeGraph Py.ConcatenatedString where scopeGraph = const (pure mempty)
+instance ToScopeGraph Py.ConcatenatedString where scopeGraph _ = mempty
 
 deriving instance ToScopeGraph Py.CompoundStatement
 
 instance ToScopeGraph Py.ConditionalExpression where scopeGraph = onChildren
 
-instance ToScopeGraph Py.ContinueStatement where scopeGraph = const (pure mempty)
+instance ToScopeGraph Py.ContinueStatement where scopeGraph _ = mempty
 
 instance ToScopeGraph Py.DecoratedDefinition where scopeGraph = todo
 
 instance ToScopeGraph Py.ComparisonOperator where scopeGraph = onChildren
 
-instance ToScopeGraph Py.DeleteStatement where scopeGraph = const (pure mempty)
+instance ToScopeGraph Py.DeleteStatement where scopeGraph _ = mempty
 
 instance ToScopeGraph Py.Dictionary where scopeGraph = onChildren
 
@@ -122,13 +132,13 @@ deriving instance ToScopeGraph Py.Expression
 instance ToScopeGraph Py.ElseClause where scopeGraph = onField @"body"
 
 instance ToScopeGraph Py.ElifClause where
-  scopeGraph (Py.ElifClause _ body condition) = mappend <$> scopeGraph condition <*> scopeGraph body
+  scopeGraph (Py.ElifClause _ body condition) = scopeGraph condition <> scopeGraph body
 
-instance ToScopeGraph Py.Ellipsis where scopeGraph = const (pure mempty)
+instance ToScopeGraph Py.Ellipsis where scopeGraph _ = mempty
 
 instance ToScopeGraph Py.ExceptClause where scopeGraph = onChildren
 
-instance ToScopeGraph Py.ExecStatement where scopeGraph = const (pure mempty)
+instance ToScopeGraph Py.ExecStatement where scopeGraph _ = mempty
 
 instance ToScopeGraph Py.ExpressionStatement where scopeGraph = onChildren
 
@@ -138,7 +148,7 @@ instance ToScopeGraph Py.False where scopeGraph _ = pure mempty
 
 instance ToScopeGraph Py.FinallyClause where scopeGraph = onField @"extraChildren"
 
-instance ToScopeGraph Py.Float where scopeGraph = const (pure mempty)
+instance ToScopeGraph Py.Float where scopeGraph _ = mempty
 
 instance ToScopeGraph Py.ForStatement where scopeGraph = todo
 
@@ -153,17 +163,15 @@ instance ToScopeGraph Py.Identifier where
     reference @Name name name RefProperties
     complete
 
-
 instance ToScopeGraph Py.IfStatement where
-  scopeGraph (Py.IfStatement _ alternative body condition) = do
-    con <- scopeGraph condition
-    bod <- scopeGraph body
-    alt <- traverse scopeGraph alternative
-    pure (fold (con : bod : alt))
+  scopeGraph (Py.IfStatement _ alternative body condition)
+    = scopeGraph condition
+    <> scopeGraph body
+    <> foldMap scopeGraph alternative
 
 instance ToScopeGraph Py.GlobalStatement where scopeGraph = todo
 
-instance ToScopeGraph Py.Integer where scopeGraph = const (pure mempty)
+instance ToScopeGraph Py.Integer where scopeGraph _ = mempty
 
 instance ToScopeGraph Py.ImportStatement where scopeGraph = todo
 
@@ -179,7 +187,7 @@ instance ToScopeGraph Py.ListSplat where scopeGraph = onChildren
 
 instance ToScopeGraph Py.NamedExpression where scopeGraph = todo
 
-instance ToScopeGraph Py.None where scopeGraph = const (pure mempty)
+instance ToScopeGraph Py.None where scopeGraph _ = mempty
 
 instance ToScopeGraph Py.NonlocalStatement where scopeGraph = todo
 
@@ -194,14 +202,14 @@ instance ToScopeGraph Py.True where
 instance ToScopeGraph Py.NotOperator where scopeGraph = onField @"argument"
 
 instance ToScopeGraph Py.Pair where
-  scopeGraph (Py.Pair _ value key) = mappend <$> scopeGraph key <*> scopeGraph value
+  scopeGraph (Py.Pair _ value key) =scopeGraph key <> scopeGraph value
 
 instance ToScopeGraph Py.ParenthesizedExpression where scopeGraph = onField @"extraChildren"
 
-instance ToScopeGraph Py.PassStatement where scopeGraph _ = pure mempty
+instance ToScopeGraph Py.PassStatement where scopeGraph _ = mempty
 
 instance ToScopeGraph Py.PrintStatement where
-  scopeGraph (Py.PrintStatement _ args _chevron) = fold <$> traverse scopeGraph args
+  scopeGraph (Py.PrintStatement _ args _chevron) = foldMap scopeGraph args
 
 deriving instance ToScopeGraph Py.PrimaryExpression
 
@@ -213,7 +221,7 @@ instance ToScopeGraph Py.Set where scopeGraph = onChildren
 
 instance ToScopeGraph Py.SetComprehension where scopeGraph = todo
 
-instance ToScopeGraph Py.String where scopeGraph _ = pure mempty
+instance ToScopeGraph Py.String where scopeGraph _ = mempty
 
 instance ToScopeGraph Py.Subscript where scopeGraph = todo
 
@@ -228,11 +236,10 @@ instance ToScopeGraph Py.TryStatement where
 instance ToScopeGraph Py.UnaryOperator where scopeGraph = onField @"argument"
 
 instance ToScopeGraph Py.WhileStatement where
-  scopeGraph Py.WhileStatement{ alternative, body, condition } = do
-    con <- scopeGraph condition
-    bod <- scopeGraph body
-    alt <- maybe (pure mempty) scopeGraph alternative
-    pure (con <> bod <> alt)
+  scopeGraph Py.WhileStatement{ alternative, body, condition }
+    = scopeGraph condition
+    <> scopeGraph body
+    <> foldMap scopeGraph alternative
 
 instance ToScopeGraph Py.WithStatement where
   scopeGraph = todo