Skip to content
Snippets Groups Projects
Commit 7ac58bd8 authored by Alice Brenon's avatar Alice Brenon
Browse files

Simplify compute-profile again to simply read from stdin and drop all the...

Simplify compute-profile again to simply read from stdin and drop all the optparse-applicative + ReadMonad combo
parent c8d591df
No related branches found
No related tags found
No related merge requests found
...@@ -4,9 +4,6 @@ ...@@ -4,9 +4,6 @@
import Conllu.Tree import Conllu.Tree
( Feat(..), IndexedDocument(..), IndexedSentence(..), IndexedToken(..) ( Feat(..), IndexedDocument(..), IndexedSentence(..), IndexedToken(..)
, positions ) , positions )
import Control.Applicative ((<**>))
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Reader (ReaderT, asks, runReaderT)
import Conllu.Tree.Count (Count(..)) import Conllu.Tree.Count (Count(..))
import Data.Csv (DefaultOrdered(..), ToNamedRecord(..)) import Data.Csv (DefaultOrdered(..), ToNamedRecord(..))
import Data.ByteString as ByteString (readFile) import Data.ByteString as ByteString (readFile)
...@@ -18,32 +15,9 @@ import GEODE.Metadata ...@@ -18,32 +15,9 @@ import GEODE.Metadata
( type(@), ArticleRecord, Document(..), ReadTSV(..), Record(..) ( type(@), ArticleRecord, Document(..), ReadTSV(..), Record(..)
, WithDefaultHeader, WriteTSV(..), for, getHeader, glue ) , WithDefaultHeader, WriteTSV(..), for, getHeader, glue )
import GHC.Generics (Generic) import GHC.Generics (Generic)
import Options.Applicative import System.Environment (getArgs)
( Parser, execParser, fullDesc, help, helper, info, long, metavar, progDesc
, short, strOption )
import System.FilePath ((</>)) import System.FilePath ((</>))
import System.Script (warn) import System.Script (syntax, 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"))
data Occurrence = Occurrence data Occurrence = Occurrence
{ event :: String { event :: String
...@@ -56,11 +30,11 @@ instance ToNamedRecord Occurrence ...@@ -56,11 +30,11 @@ instance ToNamedRecord Occurrence
type Measure = ArticleRecord @ Occurrence type Measure = ArticleRecord @ Occurrence
profile :: ArticleRecord -> ReaderT Config IO [WithDefaultHeader Measure] profile :: FilePath -> ArticleRecord -> IO [WithDefaultHeader Measure]
profile articleRecord = do profile inputRoot articleRecord =
path <- asks ((</> relativePath articleRecord "tree") . inputRoot) ByteString.readFile path >>= either skipAndWarn analyse . decode
liftIO $ ByteString.readFile path >>= either skipAndWarn analyse . decode
where where
path = inputRoot </> relativePath articleRecord "tree"
skipAndWarn msg = [] <$ warn msg skipAndWarn msg = [] <$ warn msg
analyse = pure . fmap (glue articleRecord) . findOccurrences analyse = pure . fmap (glue articleRecord) . findOccurrences
...@@ -91,9 +65,10 @@ imperativeVerb (IndexedSentence {_offset, _syntax}) = ...@@ -91,9 +65,10 @@ imperativeVerb (IndexedSentence {_offset, _syntax}) =
consIf a b = if b then (positions _offset a ++) else id consIf a b = if b then (positions _offset a ++) else id
main :: IO () main :: IO ()
main = getConfig >>= runReaderT chain main = getArgs >>= run
where where
chain = asks inputTsv >>= liftIO . readTSV >>= searchAndDisplay run [inputRoot] = do
searchAndDisplay (Document {rows}) = do Document {rows} <- readTSV ()
liftIO $ writeTSV () [getHeader (for :: Measure)] writeTSV () [getHeader (for :: Measure)]
mapM_ (\ar -> profile ar >>= liftIO . writeTSV ()) rows mapM_ (\ar -> profile inputRoot ar >>= writeTSV ()) rows
run _ = syntax "INPUT_ROOT"
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment