diff --git a/scripts/textometry/compute-profile.hs b/scripts/textometry/compute-profile.hs index 32f4527815ef528c57aba6db2c760b3fd153d939..408088890e8413a4fe4b2a1d86b279f3e303da68 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"