1
1
mirror of https://github.com/github/semantic.git synced 2024-11-25 02:58:36 +03:00

Define ToTag purely.

This commit is contained in:
Rob Rix 2019-09-24 17:15:43 -04:00
parent 4a5ab1107a
commit 32bd132c75
No known key found for this signature in database
GPG Key ID: F188A01508EA1CF7
2 changed files with 14 additions and 20 deletions

View File

@ -21,7 +21,7 @@ import qualified TreeSitter.Python.AST as Py
newtype Term a = Term { getTerm :: Py.Module a }
instance Tags.ToTags Term where
tags = tags . getTerm
tags src = Tags.runTagging src . tags . getTerm
class ToTags t where

View File

@ -1,12 +1,13 @@
{-# LANGUAGE AllowAmbiguousTypes, ConstraintKinds, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, RankNTypes, ScopedTypeVariables, TypeApplications, TypeOperators #-}
module Tags.Taggable.Precise
( runTagging
, Tags
( Tags
, ToTags(..)
, yield
, runTagging
, GFoldable1(..)
) where
import Control.Effect.Pure
import Control.Effect.Reader
import Control.Effect.Writer
import Data.Monoid (Endo(..))
@ -15,29 +16,22 @@ import Source.Loc
import Source.Source
import Tags.Tag
runTagging :: ToTags t => Source -> t Loc -> [Tag]
type Tags = Endo [Tag]
class ToTags t where
tags :: Source -> t Loc -> [Tag]
yield :: (Carrier sig m, Member (Writer Tags) sig) => Tag -> m ()
yield = tell . Endo . (:)
runTagging :: Source -> ReaderC Source (WriterC Tags PureC) () -> [Tag]
runTagging source
= ($ [])
. appEndo
. run
. execWriter
. runReader source
. tags
type Tags = Endo [Tag]
class ToTags t where
tags
:: ( Carrier sig m
, Member (Reader Source) sig
, Member (Writer Tags) sig
)
=> t Loc
-> m ()
yield :: (Carrier sig m, Member (Writer Tags) sig) => Tag -> m ()
yield = tell . Endo . (:)
-- FIXME: move GFoldable1 into semantic-ast.