From 4d27b1d72f2713489d76c60a9a37dbd8310acc94 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Tue, 3 Apr 2018 18:30:26 -0400
Subject: [PATCH] Make the options available via a Reader.

---
 src/Semantic/Task.hs | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/src/Semantic/Task.hs b/src/Semantic/Task.hs
index c5f607e1f..9ad456ced 100644
--- a/src/Semantic/Task.hs
+++ b/src/Semantic/Task.hs
@@ -76,7 +76,7 @@ type Logger = AsyncQueue Message Options
 type Statter = AsyncQueue Stat StatsClient
 
 -- | A high-level task producing some result, e.g. parsing, diffing, rendering. 'Task's can also specify explicit concurrency via 'distribute', 'distributeFor', and 'distributeFoldMap'
-type Task = Eff '[TaskF, Reader Logger, Reader Statter, Exc SomeException, IO]
+type Task = Eff '[TaskF, Reader Options, Reader Logger, Reader Statter, Exc SomeException, IO]
 
 -- | A function to compute the 'Diff' for a pair of 'Term's with arbitrary syntax functor & annotation types.
 type Differ syntax ann1 ann2 = Term syntax ann1 -> Term syntax ann2 -> Diff syntax ann1 ann2
@@ -184,8 +184,8 @@ runTaskWithOptions options task = do
     run options logger statter = run'
       where
         run' :: Task a -> IO (Either SomeException a)
-        run' = runM . runError . flip runReader statter . flip runReader logger . go
-        go :: Task a -> Eff '[Reader Logger, Reader Statter, Exc SomeException, IO] a
+        run' = runM . runError . flip runReader statter . flip runReader logger . flip runReader options . go
+        go :: Task a -> Eff '[Reader Options, Reader Logger, Reader Statter, Exc SomeException, IO] a
         go = interpret (\ task -> case task of
           ReadBlobs (Left handle) -> rethrowing (IO.readBlobsFromHandle handle)
           ReadBlobs (Right paths@[(path, Nothing)]) -> rethrowing (IO.isDirectory path >>= bool (IO.readBlobsFromPaths paths) (IO.readBlobsFromDir path))
@@ -194,7 +194,7 @@ runTaskWithOptions options task = do
           WriteToOutput destination contents -> liftIO (either B.hPutStr B.writeFile destination contents)
           WriteLog level message pairs -> ask >>= \ logger -> queueLogMessage logger level message pairs
           WriteStat stat -> ask >>= \ statter -> liftIO (queue (statter :: Statter) stat)
-          Parse parser blob -> go (runParser options blob parser)
+          Parse parser blob -> ask >>= \ options -> go (runParser options blob parser)
           Decorate algebra term -> pure (decoratorWithAlgebra algebra term)
           Semantic.Task.Diff differ term1 term2 -> pure (differ term1 term2)
           Render renderer input -> pure (renderer input)