module Lemmatchers.CLI where

import Lemmatchers.Matchers
import Lemmatchers.TagRecords
import qualified Data.ByteString as LBS
import qualified Data.Text as T
import Data.Text.Encoding
import System.Environment
import System.IO
import Control.Monad

run :: [String] -> String -> IO String
run :: [[Char]] -> [Char] -> IO [Char]
run [[Char]]
args [Char]
input = do

  -- Load matchers from command line argument
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([[Char]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Char]]
args) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall a. [Char] -> IO a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Expects matcher file name as only argument"
  Matchers
recordMatchers <- [Char] -> Matchers
forall a. Read a => [Char] -> a
read ([Char] -> Matchers) -> IO [Char] -> IO Matchers
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO [Char]
readFile ([[Char]] -> [Char]
forall a. HasCallStack => [a] -> a
head [[Char]]
args)

  -- Read data from STDIN
  let records :: [LemmaRecord]
records = ByteString -> [LemmaRecord]
csvToLemmaRecords (ByteString -> [LemmaRecord])
-> ([Char] -> ByteString) -> [Char] -> [LemmaRecord]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ByteString
str2lbs ([Char] -> [LemmaRecord]) -> [Char] -> [LemmaRecord]
forall a b. (a -> b) -> a -> b
$ [Char]
input
  let lemmi :: [Lemma]
lemmi = (LemmaRecord -> [Lemma]) -> [LemmaRecord] -> [Lemma]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Lemmas -> [Lemma]
lemmas (Lemmas -> [Lemma])
-> (LemmaRecord -> Lemmas) -> LemmaRecord -> [Lemma]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LemmaRecord -> Lemmas
lemmata) [LemmaRecord]
records
  [Char] -> IO ()
report ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$    Int -> [Char]
forall a. Show a => a -> [Char]
show ([LemmaRecord] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [LemmaRecord]
records) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" records with "
          [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++  Int -> [Char]
forall a. Show a => a -> [Char]
show ([Lemma] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Lemma]
lemmi)   [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" lemmata found."

  -- Match!
  let results :: [Match]
results = [[Match]] -> [Match]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat  [ Matcher -> LemmaRecord -> [Match]
matchRecord Matcher
m LemmaRecord
lr
                          | Matcher
m   <- Matchers -> [Matcher]
matchers Matchers
recordMatchers
                          , LemmaRecord
lr  <- [LemmaRecord]
records
                        ]

  -- Write output!
  [Char] -> IO ()
report ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> [Char]
forall a. Show a => a -> [Char]
show ([Match] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Match]
results) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" results found."
  [Char] -> IO [Char]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> IO [Char]) -> [Char] -> IO [Char]
forall a b. (a -> b) -> a -> b
$ ByteString -> [Char]
lbs2str (ByteString -> [Char]) -> ByteString -> [Char]
forall a b. (a -> b) -> a -> b
$ [Match] -> ByteString
matchesToCsv [Match]
results

  where report :: [Char] -> IO ()
report  = Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr
        str2lbs :: [Char] -> ByteString
str2lbs = ByteString -> ByteString
LBS.fromStrict (ByteString -> ByteString)
-> ([Char] -> ByteString) -> [Char] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8 (Text -> ByteString) -> ([Char] -> Text) -> [Char] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack
        lbs2str :: ByteString -> [Char]
lbs2str = Text -> [Char]
T.unpack (Text -> [Char]) -> (ByteString -> Text) -> ByteString -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
decodeUtf8 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
LBS.toStrict