Lift some constraint on the monad in and use that to pass the config around...

Lift some constraint on the monad in  and use that to pass the config around as a Reader in the new profile extractor script

lib/haskell/System/Script.hs

@@ -3,6 +3,7 @@ module System.Script
   , try
   , warn ) where
 
+import Control.Monad.IO.Class (MonadIO(..))
 import System.Exit (die)
 import System.Environment (getProgName)
 import System.IO (hPutStrLn, stderr)
@@ -13,8 +14,8 @@ syntax s = do
   this <- getProgName
   die $ printf "Syntax: %s %s" this s
 
-try :: IO (Either String a) -> IO a
-try = (>>= either die pure)
+try :: MonadIO m => m (Either String a) -> m a
+try = (>>= either (liftIO . die) pure)
 
 warn :: String -> IO ()
 warn = hPutStrLn stderr

scripts/textometry/profile.hs

@@ -4,6 +4,8 @@
 import Conllu.Parse (parseConllu)
 import Conllu.Type (AW, CW(..), Doc, Feat(..), ID(..), Rel(..), Sent(..))
 import Control.Applicative ((<**>))
+import Control.Monad.IO.Class (liftIO)
+import Control.Monad.Reader (ReaderT, asks, runReaderT)
 import Data.ByteString.Lazy as ByteString (putStr)
 import Data.Csv (ToNamedRecord(..), encodeWith)
 import Data.List (find, foldl', partition, sort)
@@ -50,11 +52,11 @@ instance HasDefaultHeader Position where
 
 type Measure = ArticleRecord @ Position
 
-profile :: Config -> ArticleRecord -> IO [WithDefaultHeader Measure]
-profile (Config {inputRoot}) articleRecord =
-  readFile inputPath >>= either skipAndWarn analyse . parseConllu inputPath
+profile :: ArticleRecord -> ReaderT Config IO [WithDefaultHeader Measure]
+profile articleRecord = do
+  path <- asks ((</> relativePath articleRecord "conllu") . inputRoot)
+  liftIO $ readFile path >>= either skipAndWarn analyse . parseConllu path
   where
-    inputPath = inputRoot </> relativePath articleRecord "conllu"
     skipAndWarn msg = [] <$ warn msg
     analyse = pure . fmap (glue articleRecord) . findOccurrences
 
@@ -63,7 +65,7 @@ findOccurrences doc =
   Position total <$> (zip (reverse offsets) doc >>= imperativeVerb)
   where
     (offsets, total) = foldl' next ([], 0) $ _words <$> doc
-    next (tmpOffsets, tmpTotal) sentence = (tmpTotal:tmpOffsets, tmpTotal + length sentence)
+    next (tmpOffsets, partial) s = (partial:tmpOffsets, partial + length s)
 
 getSID :: ID -> Maybe Int
 getSID (SID n) = Just n
@@ -94,11 +96,9 @@ syntax = build 0 . _words
     pointingTo n cw = maybe False (n ==) (getSID . _head =<< _rel cw)
 
 main :: IO ()
-main = do
-  config@(Config {inputTsv}) <- getConfig
-  try (readNamedTsv inputTsv)
-    >>= searchAndDisplay config
+main = getConfig >>= runReaderT chain
   where
-    searchAndDisplay config rows = do
-      ByteString.putStr $ encodeWith toTsv [getHeader (for :: Measure)]
-      mapM_ (\ar -> profile config ar >>= tsvLines) rows
+    chain = try (asks inputTsv >>= liftIO . readNamedTsv) >>= searchAndDisplay
+    searchAndDisplay rows = do
+      liftIO . ByteString.putStr $ encodeWith toTsv [getHeader (for :: Measure)]
+      mapM_ (\ar -> profile ar >>= liftIO . tsvLines) rows