github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-30 10:27:45 +03:00
Code Issues Projects Releases Wiki Activity

Define a Task to write output.

Browse Source
This commit is contained in:
Rob Rix 2017-07-19 15:44:22 -04:00
parent cbb6c885a4
commit 2cce3dd671
1 changed files with 7 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
src/Semantic/Task.hs
View File

@ -5,6 +5,7 @@ module Semantic.Task
, Differ
, readBlobs
, readBlobPairs
, writeToOutput
, parse
, decorate
, diff
@ -20,6 +21,7 @@ import Control.Parallel.Strategies
import qualified Control.Concurrent.Async as Async
import Control.Monad.Free.Freer
import Data.Blob
import qualified Data.ByteString as B
import Data.Functor.Both as Both
import Data.Record
import Data.Syntax.Algebra (RAlgebra, decoratorWithAlgebra)
@ -32,6 +34,7 @@ import Term
data TaskF output where
ReadBlobs :: Either Handle [(FilePath, Maybe Language)] -> TaskF [Blob]
ReadBlobPairs :: Either Handle [Both (FilePath, Maybe Language)] -> TaskF [Both Blob]
WriteToOutput :: Maybe FilePath -> ByteString -> TaskF ()
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)))
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 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'.
parse :: Parser term -> Blob -> Task term
@ -96,6 +102,7 @@ runTask :: Task a -> IO a
runTask = iterFreerA $ \ task yield -> case task of
ReadBlobs source -> Files.readBlobs 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
Decorate algebra term -> yield (decoratorWithAlgebra algebra term)
Diff differ terms -> yield (differ terms)