1
1
mirror of https://github.com/github/semantic.git synced 2024-11-24 08:54:07 +03:00
This commit is contained in:
Patrick Thomson 2020-01-14 11:44:05 -05:00
parent 353311e210
commit ba8b5b05a9

View File

@ -23,13 +23,9 @@ import Control.Carrier.State.Strict
import Control.Effect.Sketch
import Control.Monad.IO.Class
import Data.Bifunctor
import Data.Maybe
import Data.Monoid
import Data.Monoid.Generic
import Data.ScopeGraph (ScopeGraph)
import qualified Data.ScopeGraph as ScopeGraph
import Data.Semilattice.Lower
import GHC.Generics (Generic)
import qualified System.Path as Path
newtype Sketchbook address = Sketchbook
@ -40,7 +36,7 @@ newtype SketchC address m a = SketchC (StateC (Sketchbook address) (FreshC m) a)
deriving (Applicative, Functor, Monad, MonadIO)
instance forall address sig m . (Effect sig, Algebra sig m) => Algebra (Sketch address :+: sig) (SketchC address m) where
alg (L (Declare name _props k)) = do
alg (L (Declare _name _props k)) = do
k ()
alg (R other) = SketchC (alg (R (R (handleCoercible other))))
@ -49,7 +45,7 @@ runSketch ::
=> Maybe Path.AbsRelFile
-> SketchC address m a
-> m (ScopeGraph address, a)
runSketch rootpath (SketchC go)
runSketch _rootpath (SketchC go)
= evalFresh 0
. fmap (first sGraph)
. runState lowerBound