Initial port from machines to streaming.

semantic.cabal

@@ -56,7 +56,6 @@ common dependencies
                      , fused-effects-exceptions ^>= 0.1.1.0
                      , hashable ^>= 1.2.7.0
                      , tree-sitter ^>= 0.1.0.0
-                     , machines ^>= 0.6.4
                      , mtl ^>= 2.2.2
                      , network ^>= 2.8.0.0
                      , process ^>= 1.6.3.0
@@ -65,6 +64,7 @@ common dependencies
                      , safe-exceptions ^>= 0.1.7.0
                      , semilattices ^>= 0.0.0.3
                      , shelly >= 1.5 && <2
+                     , streaming ^>= 0.2.2.0
                      , text ^>= 1.2.3.1
                      , these >= 0.7 && <1
                      , unix ^>= 2.7.2.2

src/Data/Reprinting/Fragment.hs

@@ -7,8 +7,9 @@ module Data.Reprinting.Fragment
   , defer
   ) where
 
-import Data.Machine
 import Data.Text (Text)
+import Streaming
+import Streaming.Prelude (yield)
 
 import Data.Reprinting.Scope
 import Data.Reprinting.Token
@@ -25,13 +26,13 @@ data Fragment
   deriving (Eq, Show)
 
 -- | Copy along some original, un-refactored 'Text'.
-copy :: Text -> Plan k Fragment ()
+copy :: Monad m => Text -> Stream (Of Fragment) m ()
 copy = yield . Verbatim
 
 -- | Insert some new 'Text'.
-insert :: Element -> [Scope] -> Text -> Plan k Fragment ()
+insert :: Monad m => Element -> [Scope] -> Text -> Stream (Of Fragment) m ()
 insert el c = yield . New el c
 
 -- | Defer processing an element to a later stage.
-defer :: Element -> [Scope] -> Plan k Fragment ()
+defer :: Monad m => Element -> [Scope] -> Stream (Of Fragment) m ()
 defer el = yield . Defer el

src/Data/Reprinting/Splice.hs

@@ -18,7 +18,8 @@ module Data.Reprinting.Splice
 
 import Prologue hiding (Element)
 
-import Data.Machine
+import Streaming
+import Streaming.Prelude (yield)
 
 import Data.Reprinting.Fragment
 
@@ -29,29 +30,29 @@ data Splice
   deriving (Eq, Show)
 
 -- | Emit some 'Text' as a 'Splice'.
-emit :: Text -> Plan k Splice ()
+emit :: Monad m => Text -> Stream (Of Splice) m ()
 emit = yield . Emit
 
 -- | Emit the provided 'Text' if the given predicate is true.
-emitIf :: Bool -> Text -> Plan k Splice ()
+emitIf :: Monad m => Bool -> Text -> Stream (Of Splice) m ()
 emitIf p = when p . emit
 
 -- | Construct a layout 'Splice'.
-layout :: Whitespace -> Plan k Splice ()
+layout :: Monad m => Whitespace -> Stream (Of Splice) m ()
 layout = yield . Layout
 
 -- | @indent w n@ emits @w@ 'Spaces' @n@ times.
-indent :: Int -> Int -> Plan k Splice ()
+indent :: Monad m => Int -> Int -> Stream (Of Splice) m ()
 indent width times
   | times > 0 = replicateM_ times (layout (Indent width Spaces))
   | otherwise = pure ()
 
 -- | Construct multiple layouts.
-layouts :: [Whitespace] -> Plan k Splice ()
+layouts :: Monad m => [Whitespace] -> Stream (Of Splice) m ()
 layouts = traverse_ (yield . Layout)
 
 -- | Single space.
-space :: Plan k Splice ()
+space :: Monad m => Stream (Of Splice) m ()
 space = yield (Layout Space)
 
 -- | Indentation, spacing, and other whitespace.

src/Language/JSON/PrettyPrint.hs

@@ -11,7 +11,8 @@ import Prologue
 import Control.Effect
 import Control.Effect.Error
 import Control.Monad.Trans (lift)
-import Data.Machine
+import Streaming
+import qualified Streaming.Prelude as Streaming
 
 import Data.Reprinting.Errors
 import Data.Reprinting.Splice
@@ -20,16 +21,19 @@ import Data.Reprinting.Scope
 
 -- | Default printing pipeline for JSON.
 defaultJSONPipeline :: (Member (Error TranslationError) sig, Carrier sig m)
-  => ProcessT m Fragment Splice
+                    => Stream (Of Fragment) m a
+                    -> Stream (Of Splice) m a
 defaultJSONPipeline
-  = printingJSON
-  ~> beautifyingJSON defaultBeautyOpts
+  = beautifyingJSON defaultBeautyOpts
+  . printingJSON
 
 -- | Print JSON syntax.
-printingJSON :: Monad m => ProcessT m Fragment Fragment
-printingJSON = repeatedly (await >>= step) where
+printingJSON :: Monad m
+             => Stream (Of Fragment) m a
+             -> Stream (Of Fragment) m a
+printingJSON = Streaming.map step where
   step s@(Defer el cs) =
-    let ins = yield . New el cs
+    let ins = New el cs
     in case (el, listToMaybe cs) of
       (Truth True, _)      -> ins "true"
       (Truth False, _)     -> ins "false"
@@ -44,8 +48,8 @@ printingJSON = repeatedly (await >>= step) where
       (Sep, Just Pair)   -> ins ":"
       (Sep, Just Hash)   -> ins ","
 
-      _                    -> yield s
-  step x = yield x
+      _                    -> s
+  step x = x
 
 -- TODO: Fill out and implement configurable options like indentation count,
 -- tabs vs. spaces, etc.
@@ -57,8 +61,10 @@ defaultBeautyOpts = JSONBeautyOpts 2 False
 
 -- | Produce JSON with configurable whitespace and layout.
 beautifyingJSON :: (Member (Error TranslationError) sig, Carrier sig m)
-  => JSONBeautyOpts -> ProcessT m Fragment Splice
-beautifyingJSON _ = repeatedly (await >>= step) where
+                => JSONBeautyOpts
+                -> Stream (Of Fragment) m a
+                -> Stream (Of Splice) m a
+beautifyingJSON _ s = Streaming.for s step where
   step (Defer el cs)   = lift (throwError (NoTranslation el cs))
   step (Verbatim txt)  = emit txt
   step (New el cs txt) = case (el, cs) of
@@ -71,8 +77,9 @@ beautifyingJSON _ = repeatedly (await >>= step) where
 
 -- | Produce whitespace minimal JSON.
 minimizingJSON :: (Member (Error TranslationError) sig, Carrier sig m)
-  => ProcessT m Fragment Splice
-minimizingJSON = repeatedly (await >>= step) where
+               => Stream (Of Fragment) m a
+               -> Stream (Of Splice) m a
+minimizingJSON s = Streaming.for s step where
   step (Defer el cs)  = lift (throwError (NoTranslation el cs))
   step (Verbatim txt) = emit txt
   step (New _ _ txt)  = emit txt

src/Language/Python/PrettyPrint.hs

@@ -5,7 +5,8 @@ module Language.Python.PrettyPrint ( printingPython ) where
 import Control.Effect
 import Control.Effect.Error
 import Control.Monad.Trans (lift)
-import Data.Machine
+import Streaming
+import qualified Streaming.Prelude as Streaming
 
 import Data.Reprinting.Errors
 import Data.Reprinting.Splice
@@ -14,10 +15,12 @@ import Data.Reprinting.Scope
 import Data.Reprinting.Operator
 
 -- | Print Python syntax.
-printingPython :: (Member (Error TranslationError) sig, Carrier sig m) => ProcessT m Fragment Splice
-printingPython = repeatedly (await >>= step)
+printingPython :: (Member (Error TranslationError) sig, Carrier sig m)
+               => Stream (Of Fragment) m a
+               -> Stream (Of Splice) m a
+printingPython s = Streaming.for s step
 
-step :: (Member (Error TranslationError) sig, Carrier sig m) => Fragment -> PlanT k Splice m ()
+step :: (Member (Error TranslationError) sig, Carrier sig m) => Fragment -> Stream (Of Splice) m ()
 step (Verbatim txt) = emit txt
 step (New _ _ txt)  = emit txt
 step (Defer el cs)  = case (el, cs) of

src/Language/Ruby/PrettyPrint.hs

@@ -5,7 +5,8 @@ module Language.Ruby.PrettyPrint ( printingRuby ) where
 import Control.Effect
 import Control.Effect.Error
 import Control.Monad.Trans (lift)
-import Data.Machine
+import Streaming
+import qualified Streaming.Prelude as Streaming
 
 import Data.Reprinting.Scope
 import Data.Reprinting.Errors
@@ -14,10 +15,14 @@ import Data.Reprinting.Splice
 import Data.Reprinting.Token as Token
 
 -- | Print Ruby syntax.
-printingRuby :: (Member (Error TranslationError) sig, Carrier sig m) => ProcessT m Fragment Splice
-printingRuby = repeatedly (await >>= step)
+printingRuby :: (Member (Error TranslationError) sig, Carrier sig m)
+             => Stream (Of Fragment) m a
+             -> Stream (Of Splice) m a
+printingRuby s = Streaming.for s step
 
-step :: (Member (Error TranslationError) sig, Carrier sig m) => Fragment -> PlanT k Splice m ()
+step :: (Member (Error TranslationError) sig, Carrier sig m)
+     => Fragment
+     -> Stream (Of Splice) m ()
 step (Verbatim txt) = emit txt
 step (New _ _ txt)  = emit txt
 step (Defer el cs)  = case (el, cs) of

src/Reprinting/Pipeline.hs

@@ -95,7 +95,8 @@ stages of the pipeline follows:
 
 -}
 
-{-# LANGUAGE AllowAmbiguousTypes, ScopedTypeVariables, RankNTypes #-}
+{-# LANGUAGE AllowAmbiguousTypes, PartialTypeSignatures, RankNTypes, ScopedTypeVariables #-}
+{-# OPTIONS_GHC -Wno-partial-type-signatures #-}
 module Reprinting.Pipeline
   ( runReprinter
   , runTokenizing
@@ -106,10 +107,10 @@ module Reprinting.Pipeline
 import           Control.Effect as Effect
 import           Control.Effect.Error as Effect
 import           Control.Effect.State as Effect
-import           Data.Machine hiding (Source)
-import           Data.Machine.Runner
 import           Data.Text.Prettyprint.Doc
 import           Data.Text.Prettyprint.Doc.Render.Text
+import           Streaming
+import qualified Streaming.Prelude as Streaming
 
 import           Data.Reprinting.Errors
 import           Data.Reprinting.Scope
@@ -121,57 +122,58 @@ import           Reprinting.Tokenize
 import           Reprinting.Translate
 import           Reprinting.Typeset
 
-
--- | Run the reprinting pipeline given the original 'Source', a language
--- specific machine (`ProcessT`) and the provided 'Term'.
+-- | Run the reprinting pipeline given the original 'Source', a language specific
+-- translation function (as a function over 'Stream's) and the provided 'Term'.
 runReprinter :: Tokenize a
-  => Source.Source
-  -> ProcessT Translator Fragment Splice
-  -> Term a History
-  -> Either TranslationError Source.Source
-runReprinter src translating tree
+             => Source.Source
+             -> (Stream (Of Fragment) _ () -> Stream (Of Splice) _ ())
+             -> Term a History
+             -> Either TranslationError Source.Source
+runReprinter src translating
   = fmap go
   . Effect.run
   . Effect.runError
-  . fmap snd
-  . runState (mempty :: [Scope])
-  . foldT $ source (tokenizing src tree)
-      ~> contextualizing
-      ~> translating
-      ~> typesetting
+  . evalState @[Scope] mempty
+  . Streaming.mconcat_
+  . typesetting
+  . translating
+  . contextualizing
+  . tokenizing src
   where go = Source.fromText . renderStrict . layoutPretty defaultLayoutOptions
 
 -- | Run the reprinting pipeline up to tokenizing.
 runTokenizing :: Tokenize a
-  => Source.Source
-  -> Term a History
-  -> [Token]
-runTokenizing src tree
-  = Data.Machine.run $ source (tokenizing src tree)
+              => Source.Source
+              -> Term a History
+              -> [Token]
+runTokenizing src
+  = runIdentity
+  . Streaming.toList_
+  . tokenizing src
 
 -- | Run the reprinting pipeline up to contextualizing.
 runContextualizing :: Tokenize a
   => Source.Source
   -> Term a History
   -> Either TranslationError [Fragment]
-runContextualizing src tree
+runContextualizing src
   = Effect.run
   . Effect.runError
-  . fmap snd
-  . runState (mempty :: [Scope])
-  . runT $ source (tokenizing src tree)
-      ~> contextualizing
+  . evalState @[Scope] mempty
+  . Streaming.toList_
+  . contextualizing
+  . tokenizing src
 
 runTranslating :: Tokenize a
   => Source.Source
-  -> ProcessT Translator Fragment Splice
+  -> (Stream (Of Fragment) _ () -> Stream (Of Splice) _ ())
   -> Term a History
   -> Either TranslationError [Splice]
-runTranslating src translating tree
+runTranslating src translating
   = Effect.run
   . Effect.runError
-  . fmap snd
-  . runState (mempty :: [Scope])
-  . runT $ source (tokenizing src tree)
-      ~> contextualizing
-      ~> translating
+  . evalState @[Scope] mempty
+  . Streaming.toList_
+  . translating
+  . contextualizing
+  . tokenizing src

src/Reprinting/Tokenize.hs

@@ -29,10 +29,11 @@ module Reprinting.Tokenize
 
 import Prelude hiding (fail, log, filter)
 import Prologue hiding (Element, hash)
+import Streaming hiding (Sum)
+import qualified Streaming.Prelude as Streaming
 
 import           Data.History
 import           Data.List (intersperse)
-import qualified Data.Machine as Machine
 import           Data.Range
 import           Data.Reprinting.Scope (Scope)
 import qualified Data.Reprinting.Scope as Scope
@@ -55,15 +56,14 @@ data Tokenizer a where
   Get :: Tokenizer State
   Put :: State -> Tokenizer ()
 
--- Tokenizers are compiled into a Plan capable of being converted
--- to a Source. Note that the state parameter is internal to the
--- tokenizer being run: the invoker of 'tokenizing' doesn't need
--- to keep track of it at all.
-compile :: State -> Tokenizer a -> Machine.Plan k Token (State, a)
+-- Tokenizers are compiled directly into Stream values. Note that the
+-- state parameter is internal to the tokenizer being run: the invoker
+-- of 'tokenizing' doesn't need to keep track of it at all.
+compile :: Monad m => State -> Tokenizer a -> Stream (Of Token) m (State, a)
 compile p = \case
   Pure a   -> pure (p, a)
   Bind a f -> compile p a >>= (\(new, v) -> compile new (f v))
-  Tell t   -> Machine.yield t $> (p, ())
+  Tell t   -> Streaming.yield t $> (p, ())
   Get      -> pure (p, p)
   Put p'   -> pure (p', ())
 
@@ -229,12 +229,12 @@ class (Show1 constr, Traversable constr) => Tokenize constr where
   -- | Should emit control and data tokens.
   tokenize :: FAlgebra constr (Tokenizer ())
 
-tokenizing :: Tokenize a
+tokenizing :: (Monad m, Tokenize a)
            => Source
            -> Term a History
-           -> Machine.Source Token
+           -> Stream (Of Token) m ()
 tokenizing src term = pipe
-  where pipe  = Machine.construct . fmap snd $ compile state go
+  where pipe  = fmap snd $ compile state go
         state = State src (termAnnotation term) Reprinting 0 ForbidData
         go    = forbidData *> foldSubterms descend term <* finish
 

src/Reprinting/Translate.hs

@@ -5,25 +5,28 @@ module Reprinting.Translate
   , contextualizing
   ) where
 
-import           Control.Monad
 import           Control.Effect
 import           Control.Effect.Error
 import           Control.Effect.State
+import           Control.Monad
 import           Control.Monad.Trans
-import           Data.Machine
+import           Streaming
+import           Streaming.Prelude (yield)
+import qualified Streaming.Prelude as Streaming
 
 import           Data.Reprinting.Errors
+import           Data.Reprinting.Scope
 import           Data.Reprinting.Splice
 import           Data.Reprinting.Token
-import           Data.Reprinting.Scope
 import qualified Data.Source as Source
 
 type Translator
   = StateC [Scope]
   ( ErrorC TranslationError PureC)
 
-contextualizing :: ProcessT Translator Token Fragment
-contextualizing = repeatedly $ await >>= \case
+contextualizing :: Stream (Of Token) Translator a
+                -> Stream (Of Fragment) Translator a
+contextualizing s = Streaming.for s $ \case
   Chunk source -> yield . Verbatim . Source.toText $ source
   Element t -> case t of
     Run f -> lift get >>= \c -> yield (New t c f)
@@ -33,10 +36,9 @@ contextualizing = repeatedly $ await >>= \case
     Exit c  -> exitScope c
     _       -> pure ()
 
-enterScope, exitScope :: Scope -> PlanT k Fragment Translator ()
-
+-- PT TODO: this can be nicer
+enterScope, exitScope :: Scope -> Stream (Of Fragment) Translator ()
 enterScope c = lift (modify (c :))
-
 exitScope c = lift get >>= \case
   (x:xs) -> when (x == c) (lift (modify (const xs)))
   cs     -> lift (throwError (UnbalancedPair c cs))

src/Reprinting/Typeset.hs

@@ -5,12 +5,14 @@ module Reprinting.Typeset
 
 import Prologue
 
-import Data.Machine
+import Streaming
+import qualified Streaming.Prelude as Streaming
 import Data.Reprinting.Splice hiding (space)
 import Data.Text.Prettyprint.Doc
 
-typesetting :: Monad m => ProcessT m Splice (Doc a)
-typesetting = auto step
+typesetting :: Monad m => Stream (Of Splice) m x
+                       -> Stream (Of (Doc a)) m x
+typesetting = Streaming.map step
 
 step :: Splice -> Doc a
 step (Emit t)                   = pretty t
@@ -23,8 +25,10 @@ step (Layout (Indent 0 Tabs))   = mempty
 step (Layout (Indent n Tabs))   = stimes n "\t"
 
 -- | Typeset, but show whitespace with printable characters for debugging purposes.
-typesettingWithVisualWhitespace :: Monad m => ProcessT m Splice (Doc a)
-typesettingWithVisualWhitespace = auto step where
+typesettingWithVisualWhitespace :: Monad m
+                                => Stream (Of Splice) m x
+                                -> Stream (Of (Doc a)) m x
+typesettingWithVisualWhitespace = Streaming.map step where
   step :: Splice -> Doc a
   step (Emit t)                   = pretty t
   step (Layout SoftWrap)          = softline

src/Tags/Taggable.hs

@@ -28,14 +28,15 @@ import Analysis.HasTextElement
 import Data.Abstract.Declarations
 import Data.Abstract.Name
 import Data.Blob
-import Data.Functor.Identity
 import Data.Language
 import Data.Location
-import Data.Machine as Machine
 import Data.Range
 import Data.Term
 import Data.Text hiding (empty)
 
+import Streaming hiding (Sum)
+import Streaming.Prelude (yield)
+
 import qualified Data.Syntax as Syntax
 import qualified Data.Syntax.Comment as Comment
 import qualified Data.Syntax.Declaration as Declaration
@@ -63,13 +64,13 @@ data Token
   | Iden  { identifierName :: Text, tokenSpan :: Span, docsLiteralRange :: Maybe Range }
   deriving (Eq, Show)
 
-type Tagger k a = PlanT k Token Identity a
+type Tagger = Stream (Of Token)
 
-enter, exit :: String -> Maybe Range -> Tagger k ()
+enter, exit :: Monad m => String -> Maybe Range -> Tagger m ()
 enter c = yield . Enter (pack c)
 exit c = yield . Exit (pack c)
 
-emitIden :: Span -> Maybe Range -> Name -> Tagger k ()
+emitIden :: Monad m => Span -> Maybe Range -> Name -> Tagger m ()
 emitIden span docsLiteralRange name = yield (Iden (formatName name) span docsLiteralRange)
 
 class (Show1 constr, Traversable constr) => Taggable constr where
@@ -98,11 +99,11 @@ type IsTaggable syntax =
   , HasTextElement syntax
   )
 
-tagging :: (IsTaggable syntax)
+tagging :: (Monad m, IsTaggable syntax)
         => Blob
         -> Term syntax Location
-        -> Machine.MachineT Identity k Token
-tagging b = Machine.construct . foldSubterms (descend (blobLanguage b))
+        -> Stream (Of Token) m ()
+tagging b = foldSubterms (descend (blobLanguage b))
 
 descend ::
   ( Taggable (TermF syntax Location)
@@ -111,8 +112,9 @@ descend ::
   , Foldable syntax
   , HasTextElement syntax
   , Declarations1 syntax
+  , Monad m
   )
-  => Language -> SubtermAlgebra (TermF syntax Location) (Term syntax Location) (Tagger k ())
+  => Language -> SubtermAlgebra (TermF syntax Location) (Term syntax Location) (Tagger m ())
 descend lang t@(In loc _) = do
   let term = fmap subterm t
   let snippetRange = snippet loc term

src/Tags/Tagging.hs

@@ -11,35 +11,41 @@ import Prologue hiding (Element, hash)
 import           Control.Effect as Eff
 import           Control.Effect.State
 import           Control.Monad.Trans
+import           Data.Text as T hiding (empty)
+import           Streaming
+import           Streaming.Prelude (yield)
+import qualified Streaming.Prelude as Streaming
+
 import           Data.Blob
 import           Data.Location
-import           Data.Machine as Machine
 import qualified Data.Source as Source
 import           Data.Tag
 import           Data.Term
-import           Data.Text as T hiding (empty)
 import           Tags.Taggable
 
 runTagging :: (IsTaggable syntax)
-  => Blob
-  -> [Text]
-  -> Term syntax Location
-  -> [Tag]
-runTagging blob symbolsToSummarize tree
+           => Blob
+           -> [Text]
+           -> Term syntax Location
+           -> [Tag]
+runTagging blob symbolsToSummarize
   = Eff.run
   . evalState @[ContextToken] []
-  . runT $ source (tagging blob tree)
-      ~> contextualizing blob symbolsToSummarize
+  . Streaming.toList_
+  . contextualizing blob symbolsToSummarize
+  . tagging blob
 
 type ContextToken = (Text, Maybe Range)
 
+-- PT TODO: fix me as well
 contextualizing :: ( Member (State [ContextToken]) sig
                    , Carrier sig m
                    )
                 => Blob
                 -> [Text]
-                -> Machine.ProcessT m Token Tag
-contextualizing Blob{..} symbolsToSummarize = repeatedly $ await >>= \case
+                -> Stream (Of Token) m a
+                -> Stream (Of Tag) m a
+contextualizing Blob{..} symbolsToSummarize s = Streaming.for s $ \case
   Enter x r -> lift (enterScope (x, r))
   Exit  x r -> lift (exitScope (x, r))
   Iden iden span docsLiteralRange -> lift (get @[ContextToken]) >>= \case

test/Reprinting/Spec.hs

@@ -5,7 +5,8 @@ module Reprinting.Spec (spec) where
 import SpecHelpers
 
 import           Data.Foldable
-import qualified Data.Machine as Machine
+import           Streaming hiding (Sum)
+import qualified Streaming.Prelude as Streaming
 
 import           Control.Rewriting
 import qualified Data.Language as Language
@@ -35,13 +36,13 @@ spec = describe "reprinting" $ do
 
       it "should pass over a pristine tree" $ do
         let tagged = mark Unmodified tree
-        let toks = Machine.run $ tokenizing src tagged
+        let toks = runIdentity . Streaming.toList_ $ tokenizing src tagged
         toks `shouldSatisfy` not . null
         head toks `shouldSatisfy` isControl
         last toks `shouldSatisfy` isChunk
 
       it "should emit control tokens but only 1 chunk for a wholly-modified tree" $ do
-        let toks = Machine.run $ tokenizing src (mark Refactored tree)
+        let toks = runIdentity . Streaming.toList_ $ tokenizing src (mark Refactored tree)
         for_ @[] [List, Hash] $ \t -> do
           toks `shouldSatisfy` elem (Control (Enter t))
           toks `shouldSatisfy` elem (Control (Exit t))