From 7ac58bd8e16b517178ae1a5a963aa7312c734cab Mon Sep 17 00:00:00 2001
From: Alice BRENON <alice.brenon@ens-lyon.fr>
Date: Thu, 8 Feb 2024 14:58:50 +0100
Subject: [PATCH] Simplify compute-profile again to simply read from stdin and
drop all the optparse-applicative + ReadMonad combo
---
scripts/textometry/compute-profile.hs | 49 +++++++--------------------
1 file changed, 12 insertions(+), 37 deletions(-)
diff --git a/scripts/textometry/compute-profile.hs b/scripts/textometry/compute-profile.hs
index 32f4527..4080888 100755
--- a/scripts/textometry/compute-profile.hs
+++ b/scripts/textometry/compute-profile.hs
@@ -4,9 +4,6 @@
import Conllu.Tree
( Feat(..), IndexedDocument(..), IndexedSentence(..), IndexedToken(..)
, positions )
-import Control.Applicative ((<**>))
-import Control.Monad.IO.Class (liftIO)
-import Control.Monad.Reader (ReaderT, asks, runReaderT)
import Conllu.Tree.Count (Count(..))
import Data.Csv (DefaultOrdered(..), ToNamedRecord(..))
import Data.ByteString as ByteString (readFile)
@@ -18,32 +15,9 @@ import GEODE.Metadata
( type(@), ArticleRecord, Document(..), ReadTSV(..), Record(..)
, WithDefaultHeader, WriteTSV(..), for, getHeader, glue )
import GHC.Generics (Generic)
-import Options.Applicative
- ( Parser, execParser, fullDesc, help, helper, info, long, metavar, progDesc
- , short, strOption )
+import System.Environment (getArgs)
import System.FilePath ((</>))
-import System.Script (warn)
-
-data Config = Config
- { inputRoot :: FilePath
- , inputTsv :: FilePath }
-
-configParser :: Parser Config
-configParser = Config
- <$> strOption root
- <*> strOption inputTsvArg
- where
- root = short 'r' <> long "root" <> metavar "TREE_DIRECTORY"
- <> help "path to the base directory containing the syntax annotations"
- inputTsvArg = short 'i' <> long "input" <> metavar "INPUT_TSV"
- <> help "TSV file containing the article records to process"
-
-getConfig :: IO Config
-getConfig = execParser
- (info
- (configParser <**> helper)
- (fullDesc
- <> progDesc "A textometric tool to draw discursive profiles"))
+import System.Script (syntax, warn)
data Occurrence = Occurrence
{ event :: String
@@ -56,11 +30,11 @@ instance ToNamedRecord Occurrence
type Measure = ArticleRecord @ Occurrence
-profile :: ArticleRecord -> ReaderT Config IO [WithDefaultHeader Measure]
-profile articleRecord = do
- path <- asks ((</> relativePath articleRecord "tree") . inputRoot)
- liftIO $ ByteString.readFile path >>= either skipAndWarn analyse . decode
+profile :: FilePath -> ArticleRecord -> IO [WithDefaultHeader Measure]
+profile inputRoot articleRecord =
+ ByteString.readFile path >>= either skipAndWarn analyse . decode
where
+ path = inputRoot </> relativePath articleRecord "tree"
skipAndWarn msg = [] <$ warn msg
analyse = pure . fmap (glue articleRecord) . findOccurrences
@@ -91,9 +65,10 @@ imperativeVerb (IndexedSentence {_offset, _syntax}) =
consIf a b = if b then (positions _offset a ++) else id
main :: IO ()
-main = getConfig >>= runReaderT chain
+main = getArgs >>= run
where
- chain = asks inputTsv >>= liftIO . readTSV >>= searchAndDisplay
- searchAndDisplay (Document {rows}) = do
- liftIO $ writeTSV () [getHeader (for :: Measure)]
- mapM_ (\ar -> profile ar >>= liftIO . writeTSV ()) rows
+ run [inputRoot] = do
+ Document {rows} <- readTSV ()
+ writeTSV () [getHeader (for :: Measure)]
+ mapM_ (\ar -> profile inputRoot ar >>= writeTSV ()) rows
+ run _ = syntax "INPUT_ROOT"
--
GitLab