Output to builders.

src/Analysis/Abstract/Graph.hs

@@ -24,7 +24,6 @@ import           Data.Abstract.Package (PackageInfo(..))
 import           Data.Aeson hiding (Result)
 import           Data.ByteString.Builder
 import qualified Data.ByteString.Char8 as BC
-import           Data.ByteString.Lazy (toStrict)
 import           Data.Graph
 import           Data.Output
 import qualified Data.Syntax as Syntax
@@ -144,7 +143,7 @@ appendGraph = modify' . (<>)
 
 
 instance Output (Graph Vertex) where
-  toOutput = toStrict . (<> "\n") . encode
+  toOutput = fromEncoding . toEncoding
 
 instance ToJSON Vertex where
   toJSON v = object [ "name" .= vertexToText v, "type" .= vertexToType v ]

src/Data/Output.hs

@@ -2,27 +2,18 @@ module Data.Output
 ( Output(..)
 ) where
 
-import Data.Aeson (Value, encode)
-import Data.ByteString.Builder (Builder, toLazyByteString)
-import Data.ByteString.Lazy (toStrict)
-import Data.Text (Text, intercalate)
-import Data.Text.Encoding (encodeUtf8)
+import Data.Aeson (Value, fromEncoding, toEncoding)
+import Data.ByteString.Builder (Builder, byteString)
 import Prologue
 
 class Monoid o => Output o where
-  toOutput :: o -> ByteString
-
-instance Output ByteString where
-  toOutput s = s
-
-instance Output [Text] where
-  toOutput = encodeUtf8 . intercalate "\n"
-
-instance Output (Map Text Value) where
-  toOutput = toStrict . (<> "\n") . encode
+  toOutput :: o -> Builder
 
 instance Output [Value] where
-  toOutput = toStrict . (<> "\n") . encode
+  toOutput = fromEncoding . toEncoding
+
+instance Output ByteString where
+  toOutput = byteString
 
 instance Output Builder where
-  toOutput = toStrict . toLazyByteString
+  toOutput = id

src/Rendering/Imports.hs

@@ -9,7 +9,6 @@ import Analysis.Declaration
 import Analysis.PackageDef
 import Data.Aeson
 import Data.Blob
-import Data.ByteString.Lazy (toStrict)
 import Data.Record
 import Data.Output
 import Data.Span
@@ -30,7 +29,7 @@ instance Monoid ImportSummary where
   mappend = (<>)
 
 instance Output ImportSummary where
-  toOutput = toStrict . (<> "\n") . encode
+  toOutput = fromEncoding . toEncoding
 
 instance ToJSON ImportSummary where
   toJSON (ImportSummary m) = object [ "modules" .= m ]

src/Rendering/JSON.hs

@@ -14,7 +14,6 @@ import Data.Aeson (ToJSON, toJSON, object, (.=))
 import Data.Aeson as A
 import Data.JSON.Fields
 import Data.Blob
-import Data.ByteString.Lazy (toStrict)
 import qualified Data.Map.Monoidal as Monoidal
 import Data.Output
 import Data.Patch
@@ -28,7 +27,7 @@ toJSONOutput key = JSONOutput . Monoidal.singleton key
 
 
 instance Output JSONOutput where
-  toOutput = toStrict . encode . unJSONOutput
+  toOutput = fromEncoding . toEncoding
 
 
 -- | Render a diff to a value representing its JSON.

src/Rendering/TOC.hs

@@ -21,7 +21,6 @@ import Analysis.Declaration
 import Data.Aeson
 import Data.Align (bicrosswalk)
 import Data.Blob
-import Data.ByteString.Lazy (toStrict)
 import Data.Diff
 import Data.Language as Language
 import Data.List (sortOn)
@@ -45,7 +44,7 @@ instance Monoid Summaries where
   mappend = (<>)
 
 instance Output Summaries where
-  toOutput = toStrict . (<> "\n") . encode
+  toOutput = fromEncoding . toEncoding
 
 instance ToJSON Summaries where
   toJSON Summaries{..} = object [ "changes" .= changes, "errors" .= errors ]

src/Semantic/CLI.hs

@@ -6,6 +6,7 @@ module Semantic.CLI
 , runParse
 ) where
 
+import           Data.ByteString.Builder
 import           Data.File
 import           Data.Language (Language)
 import           Data.List (intercalate)
@@ -30,13 +31,13 @@ import           Text.Read
 main :: IO ()
 main = customExecParser (prefs showHelpOnEmpty) arguments >>= uncurry Task.runTaskWithOptions
 
-runDiff :: SomeRenderer DiffRenderer -> Either Handle [Both File] -> Task.TaskEff ByteString
+runDiff :: SomeRenderer DiffRenderer -> Either Handle [Both File] -> Task.TaskEff Builder
 runDiff (SomeRenderer diffRenderer) = fmap toOutput . Semantic.diffBlobPairs diffRenderer <=< Task.readBlobPairs
 
-runParse :: SomeRenderer TermRenderer -> Either Handle [File] -> Task.TaskEff ByteString
+runParse :: SomeRenderer TermRenderer -> Either Handle [File] -> Task.TaskEff Builder
 runParse (SomeRenderer parseTreeRenderer) = fmap toOutput . Semantic.parseBlobs parseTreeRenderer <=< Task.readBlobs
 
-runASTParse :: SomeRenderer TermRenderer -> Either Handle [File] -> Task.TaskEff ByteString
+runASTParse :: SomeRenderer TermRenderer -> Either Handle [File] -> Task.TaskEff Builder
 runASTParse (SomeRenderer parseTreeRenderer) = fmap toOutput . Semantic.astParseBlobs parseTreeRenderer <=< Task.readBlobs
 
 runGraph :: Semantic.GraphType -> Maybe FilePath -> FilePath -> Language -> [FilePath] -> Task.TaskEff (Graph Vertex)

src/Semantic/IO.hs

@@ -31,6 +31,7 @@ import qualified Data.Blob as Blob
 import           Data.Bool
 import           Data.File
 import qualified Data.ByteString as B
+import qualified Data.ByteString.Builder as B
 import qualified Data.ByteString.Lazy as BL
 import           Data.Language
 import           Data.Source
@@ -42,7 +43,7 @@ import           System.Directory.Tree (AnchoredDirTree(..))
 import           System.Exit
 import           System.FilePath
 import           System.FilePath.Glob
-import           System.IO (Handle)
+import           System.IO (Handle, IOMode(..), withBinaryFile)
 import           Text.Read
 
 -- | Read a utf8-encoded file to a 'Blob'.
@@ -196,8 +197,8 @@ readBlobPairs = send . ReadBlobPairs
 readProject :: Member Files effs => Maybe FilePath -> FilePath -> Language -> [FilePath] -> Eff effs Project
 readProject rootDir dir excludeDirs = send . ReadProject rootDir dir excludeDirs
 
--- | A task which writes a 'B.ByteString' to a 'Handle' or a 'FilePath'.
-writeToOutput :: Member Files effs => Either Handle FilePath -> B.ByteString -> Eff effs ()
+-- | A task which writes a 'B.Builder' to a 'Handle' or a 'FilePath'.
+writeToOutput :: Member Files effs => Either Handle FilePath -> B.Builder -> Eff effs ()
 writeToOutput path = send . WriteToOutput path
 
 
@@ -207,7 +208,7 @@ data Files out where
   ReadBlobs     :: Either Handle [File] -> Files [Blob.Blob]
   ReadBlobPairs :: Either Handle [Both File] -> Files [Blob.BlobPair]
   ReadProject   :: Maybe FilePath -> FilePath -> Language -> [FilePath] -> Files Project
-  WriteToOutput :: Either Handle FilePath -> B.ByteString -> Files ()
+  WriteToOutput :: Either Handle FilePath -> B.Builder -> Files ()
 
 -- | Run a 'Files' effect in 'IO'.
 runFiles :: Members '[Exc SomeException, IO] effs => Eff (Files ': effs) a -> Eff effs a
@@ -218,7 +219,7 @@ runFiles = interpret $ \ files -> case files of
   ReadBlobs (Right paths) -> rethrowing (readBlobsFromPaths paths)
   ReadBlobPairs source -> rethrowing (either readBlobPairsFromHandle (traverse (runBothWith readFilePair)) source)
   ReadProject rootDir dir language excludeDirs -> rethrowing (readProjectFromPaths rootDir dir language excludeDirs)
-  WriteToOutput destination contents -> liftIO (either B.hPutStr B.writeFile destination contents)
+  WriteToOutput destination contents -> liftIO (either B.hPutBuilder (\ path -> withBinaryFile path WriteMode . flip B.hPutBuilder) destination contents)
 
 
 -- | Catch exceptions in 'IO' actions embedded in 'Eff', handling them with the passed function.