diff --git a/lib/haskell/System/Script.hs b/lib/haskell/System/Script.hs
index 5f54942d0aff313018a1b4694145de49c9b6e85e..d71f3b6a429c8551c284a3efc7cba3c998f78d59 100644
--- a/lib/haskell/System/Script.hs
+++ b/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
diff --git a/scripts/textometry/profile.hs b/scripts/textometry/profile.hs
index f9fc6bd00270f728992bb0c2ee7c03bfb382b6dc..92997ba39a9392c62756f8c50b899f712625df08 100755
--- a/scripts/textometry/profile.hs
+++ b/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