mirror of
https://github.com/github/semantic.git
synced 2024-12-21 05:41:54 +03:00
Define a Task to write output.
This commit is contained in:
parent
cbb6c885a4
commit
2cce3dd671
@ -5,6 +5,7 @@ module Semantic.Task
|
|||||||
, Differ
|
, Differ
|
||||||
, readBlobs
|
, readBlobs
|
||||||
, readBlobPairs
|
, readBlobPairs
|
||||||
|
, writeToOutput
|
||||||
, parse
|
, parse
|
||||||
, decorate
|
, decorate
|
||||||
, diff
|
, diff
|
||||||
@ -20,6 +21,7 @@ import Control.Parallel.Strategies
|
|||||||
import qualified Control.Concurrent.Async as Async
|
import qualified Control.Concurrent.Async as Async
|
||||||
import Control.Monad.Free.Freer
|
import Control.Monad.Free.Freer
|
||||||
import Data.Blob
|
import Data.Blob
|
||||||
|
import qualified Data.ByteString as B
|
||||||
import Data.Functor.Both as Both
|
import Data.Functor.Both as Both
|
||||||
import Data.Record
|
import Data.Record
|
||||||
import Data.Syntax.Algebra (RAlgebra, decoratorWithAlgebra)
|
import Data.Syntax.Algebra (RAlgebra, decoratorWithAlgebra)
|
||||||
@ -32,6 +34,7 @@ import Term
|
|||||||
data TaskF output where
|
data TaskF output where
|
||||||
ReadBlobs :: Either Handle [(FilePath, Maybe Language)] -> TaskF [Blob]
|
ReadBlobs :: Either Handle [(FilePath, Maybe Language)] -> TaskF [Blob]
|
||||||
ReadBlobPairs :: Either Handle [Both (FilePath, Maybe Language)] -> TaskF [Both Blob]
|
ReadBlobPairs :: Either Handle [Both (FilePath, Maybe Language)] -> TaskF [Both Blob]
|
||||||
|
WriteToOutput :: Maybe FilePath -> ByteString -> TaskF ()
|
||||||
Parse :: Parser term -> Blob -> TaskF term
|
Parse :: Parser term -> Blob -> TaskF term
|
||||||
Decorate :: Functor f => RAlgebra (TermF f (Record fields)) (Term f (Record fields)) field -> Term f (Record fields) -> TaskF (Term f (Record (field ': fields)))
|
Decorate :: Functor f => RAlgebra (TermF f (Record fields)) (Term f (Record fields)) field -> Term f (Record fields) -> TaskF (Term f (Record (field ': fields)))
|
||||||
Diff :: Differ f a -> Both (Term f a) -> TaskF (Diff f a)
|
Diff :: Differ f a -> Both (Term f a) -> TaskF (Diff f a)
|
||||||
@ -55,6 +58,9 @@ readBlobs from = ReadBlobs from `Then` return
|
|||||||
readBlobPairs :: Either Handle [Both (FilePath, Maybe Language)] -> Task [Both Blob]
|
readBlobPairs :: Either Handle [Both (FilePath, Maybe Language)] -> Task [Both Blob]
|
||||||
readBlobPairs from = ReadBlobPairs from `Then` return
|
readBlobPairs from = ReadBlobPairs from `Then` return
|
||||||
|
|
||||||
|
writeToOutput :: Maybe FilePath -> ByteString -> Task ()
|
||||||
|
writeToOutput path contents = WriteToOutput path contents `Then` return
|
||||||
|
|
||||||
|
|
||||||
-- | A 'Task' which parses 'Source' with the given 'Parser'.
|
-- | A 'Task' which parses 'Source' with the given 'Parser'.
|
||||||
parse :: Parser term -> Blob -> Task term
|
parse :: Parser term -> Blob -> Task term
|
||||||
@ -96,6 +102,7 @@ runTask :: Task a -> IO a
|
|||||||
runTask = iterFreerA $ \ task yield -> case task of
|
runTask = iterFreerA $ \ task yield -> case task of
|
||||||
ReadBlobs source -> Files.readBlobs source >>= yield
|
ReadBlobs source -> Files.readBlobs source >>= yield
|
||||||
ReadBlobPairs source -> Files.readBlobPairs source >>= yield
|
ReadBlobPairs source -> Files.readBlobPairs source >>= yield
|
||||||
|
WriteToOutput path contents -> maybe B.putStr B.writeFile path contents >>= yield
|
||||||
Parse parser blob -> runParser parser blob >>= yield
|
Parse parser blob -> runParser parser blob >>= yield
|
||||||
Decorate algebra term -> yield (decoratorWithAlgebra algebra term)
|
Decorate algebra term -> yield (decoratorWithAlgebra algebra term)
|
||||||
Diff differ terms -> yield (differ terms)
|
Diff differ terms -> yield (differ terms)
|
||||||
|
Loading…
Reference in New Issue
Block a user