Initial port from machines to streaming.

Author: Patrick Thomson

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)
-
-step :: (Member (Error TranslationError) sig, Carrier sig m) => Fragment -> PlanT k Splice m ()
+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
+     -> 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