github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-21 05:41:54 +03:00
Code Issues Projects Releases Wiki Activity

Log messages to stderr.

Browse Source
This commit is contained in:
Rob Rix 2017-07-21 11:38:17 -04:00
parent 6c272105a4
commit e2a21addf2
1 changed files with 8 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
src/Semantic/Task.hs
View File

@ -7,6 +7,7 @@ module Semantic.Task
, readBlobs , readBlobs
, readBlobPairs , readBlobPairs
, writeToOutput , writeToOutput
, writeLog
, parse , parse
, decorate , decorate
, diff , diff
@ -36,6 +37,7 @@ 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 :: Either Handle FilePath -> ByteString -> TaskF () WriteToOutput :: Either Handle FilePath -> ByteString -> TaskF ()
WriteLog :: Message -> 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)
@ -76,6 +78,11 @@ writeToOutput :: Either Handle FilePath -> ByteString -> Task ()
writeToOutput path contents = WriteToOutput path contents `Then` return writeToOutput path contents = WriteToOutput path contents `Then` return
-- | A 'Task' which logs a message at a specific log level to stderr.
writeLog :: Message -> Task ()
writeLog message = WriteLog message `Then` return
-- | A 'Task' which parses a 'Blob' with the given 'Parser'. -- | A 'Task' which parses a 'Blob' with the given 'Parser'.
parse :: Parser term -> Blob -> Task term parse :: Parser term -> Blob -> Task term
parse parser blob = Parse parser blob `Then` return parse parser blob = Parse parser blob `Then` return
@ -117,6 +124,7 @@ runTask = iterFreerA $ \ task yield -> case task of
ReadBlobs source -> either Files.readBlobsFromHandle (traverse (uncurry Files.readFile)) source >>= yield ReadBlobs source -> either Files.readBlobsFromHandle (traverse (uncurry Files.readFile)) source >>= yield
ReadBlobPairs source -> either Files.readBlobPairsFromHandle (traverse (traverse (uncurry Files.readFile))) source >>= yield ReadBlobPairs source -> either Files.readBlobPairsFromHandle (traverse (traverse (uncurry Files.readFile))) source >>= yield
WriteToOutput destination contents -> either B.hPutStr B.writeFile destination contents >>= yield WriteToOutput destination contents -> either B.hPutStr B.writeFile destination contents >>= yield
WriteLog message -> B.hPutStr stderr (formatMessage message) >>= 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)