Merge branch 'master' into add-php

Author: joshvera

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
@@ -308,7 +308,6 @@ library
                      , profunctors ^>= 5.3
                      , reducers ^>= 3.12.3
                      , semigroupoids ^>= 5.3.2
-                     , servant ^>= 0.15
                      , split ^>= 0.2.3.3
                      , stm-chans ^>= 3.0.0.4
                      , template-haskell ^>= 2.14

src/Data/Language.hs

@@ -108,6 +108,7 @@ languageForType mediaType = case mediaType of
     ".rb"   -> Ruby
     ".go"   -> Go
     ".js"   -> JavaScript
+    ".mjs"  -> JavaScript
     ".ts"   -> TypeScript
     ".tsx"  -> TSX
     ".jsx"  -> JSX
@@ -120,7 +121,7 @@ extensionsForLanguage :: Language -> [String]
 extensionsForLanguage language = case language of
   Go         -> [".go"]
   Haskell    -> [".hs"]
-  JavaScript -> [".js"]
+  JavaScript -> [".js", ".mjs"]
   PHP        -> [".php", ".phpt"]
   Python     -> [".py"]
   Ruby       -> [".rb"]
@@ -134,7 +135,7 @@ languageForFilePath :: FilePath -> Language
 languageForFilePath = languageForType . takeExtension
 
 supportedExts :: [String]
-supportedExts = [".go", ".py", ".rb", ".js", ".ts", ".php", ".phpt"]
+supportedExts = [".go", ".py", ".rb", ".js", ".mjs", ".ts", ".php", ".phpt"]
 
 codeNavLanguages :: [Language]
 codeNavLanguages = [Go, Ruby, Python, JavaScript, TypeScript, PHP]

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

@@ -8,32 +8,35 @@ module Language.JSON.PrettyPrint
 
 import Prologue
 
-import Control.Effect
-import Control.Effect.Error
-import Control.Monad.Trans (lift)
-import Data.Machine
+import           Control.Effect
+import           Control.Effect.Error
+import           Streaming
+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
 
 -- | 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"
-      (Nullity, _)         -> ins "null"
+      (Truth True, _)    -> ins "true"
+      (Truth False, _)   -> ins "false"
+      (Nullity, _)       -> ins "null"
 
       (Open,  Just List) -> ins "["
       (Close, Just List) -> ins "]"
@@ -44,8 +47,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,23 +60,26 @@ 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
-  step (Defer el cs)   = lift (throwError (NoTranslation el cs))
+                => JSONBeautyOpts
+                -> Stream (Of Fragment) m a
+                -> Stream (Of Splice) m a
+beautifyingJSON _ s = Streaming.for s step where
+  step (Defer el cs)   = effect (throwError (NoTranslation el cs))
   step (Verbatim txt)  = emit txt
   step (New el cs txt) = case (el, cs) of
     (Open,  Hash:_)    -> emit txt *> layout HardWrap *> indent 2 (hashDepth cs)
     (Close, Hash:rest) -> layout HardWrap *> indent 2 (hashDepth rest) *> emit txt
     (Sep,   List:_)    -> emit txt *> space
     (Sep,   Pair:_)    -> emit txt *> space
     (Sep,   Hash:_)    -> emit txt *> layout HardWrap *> indent 2 (hashDepth cs)
-    _                    -> emit txt
+    _                  -> emit txt
 
 -- | Produce whitespace minimal JSON.
 minimizingJSON :: (Member (Error TranslationError) sig, Carrier sig m)
-  => ProcessT m Fragment Splice
-minimizingJSON = repeatedly (await >>= step) where
-  step (Defer el cs)  = lift (throwError (NoTranslation el cs))
+               => Stream (Of Fragment) m a
+               -> Stream (Of Splice) m a
+minimizingJSON s = Streaming.for s step where
+  step (Defer el cs)  = effect (throwError (NoTranslation el cs))
   step (Verbatim txt) = emit txt
   step (New _ _ txt)  = emit txt
 

src/Language/Python/PrettyPrint.hs

@@ -4,8 +4,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 +14,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
@@ -63,7 +65,7 @@ step (Defer el cs)  = case (el, cs) of
   (Sep,   Imperative:xs)        -> layout HardWrap *> indent 4 (imperativeDepth xs)
   (Close, Imperative:_)         -> pure ()
 
-  _                              -> lift (throwError (NoTranslation el cs))
+  _                             -> effect (throwError (NoTranslation el cs))
 
   where
     endContext times = layout HardWrap *> indent 4 (pred times)

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
@@ -47,9 +52,9 @@ step (Defer el cs)  = case (el, cs) of
   (Close, [Imperative])         -> layout HardWrap
   (Close, Imperative:xs)        -> indent 2 (pred (imperativeDepth xs))
 
-  (Sep, Call:_)                -> emit "."
+  (Sep, Call:_)                 -> emit "."
 
-  _                              -> lift (throwError (NoTranslation el cs))
+  _                             -> effect (throwError (NoTranslation el cs))
 
   where
     endContext times = layout HardWrap *> indent 2 (pred times)