geni-util-0.24.1: geni-util-cmd/Client.hs

module Client where

import           Control.Monad          (when, unless, forM)
import qualified Data.ByteString.Char8  as BC
import           Data.Monoid
import qualified Data.Text              as T
import           Data.Version
import           Data.Word              (Word16)
import           System.Environment
import           System.FilePath
import           System.IO

import           NLP.GenI
import           NLP.GenI.Configuration (emptyParams, setFlag, hasFlag,
                                         processInstructions,
                                         TestSuiteFlg(..), BatchDirFlg(..))
import           NLP.GenI.Console       (writeResults, RunAs(PartOfSuite),
                                         getBatchDir)
import           NLP.GenI.TestSuite
import qualified Text.JSON              as Json

import           Config
import           NLP.GenI.Client       (realise)

main :: GeniUtil -> IO ()
main opts@Client{} = do
    when (null (suite opts)) $
        fail "Need a suite"
    let server_ = BC.pack (server opts)
        port_   = port opts
    params_ <- processInstructions
        $ setFlag TestSuiteFlg (suite opts)
        $ emptyParams
    let params = if null (batchDir opts)
                    then params_
                    else setFlag BatchDirFlg (batchDir opts) params_
        pst = emptyProgState params
    batchDir  <- getBatchDir params
    wrangler  <- defaultCustomSem pst
    fullsuite <- loadTestSuite pst wrangler
    let subBatchDir = batchDir </> takeFileName (suite opts)
    forM fullsuite $ \tc -> do
        -- FIXME: we should figure out what to do about params
        mres <- realise server_ port_ [] (tcSemString tc)
        case mres of
            Json.Ok res -> do
                writeResults pst (PartOfSuite (tcName tc) subBatchDir)
                    wrangler (tcSemString tc) (tcSem tc) res
                putStr . T.unpack . T.unlines $
                    concat [ grRealisations x | GSuccess x <- grResults res ]
            Json.Error err ->
                fail $ "JSON decode error:\n" ++ err
    unless (hasFlag BatchDirFlg pst) $ hPutStr stderr . unlines $
        [ ""
        , "Results saved to directory " ++ batchDir
        , "To save results in a different directory, use the --batchdir flag"
        ]
mainGeniClient _ = error "geni-util routing (client)"