1
1
mirror of https://github.com/github/semantic.git synced 2024-12-22 22:31:36 +03:00

Output to builders.

This commit is contained in:
Rob Rix 2018-05-11 16:37:04 -04:00
parent 60c3c112d4
commit eb41652cbd
7 changed files with 22 additions and 33 deletions

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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