{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE FlexibleContexts #-}
module Hasklepias.LineFilterApp
( makeLineFilterApp
, makeFilterEventLineApp
, runLineFilterAppSimple
, runFilterEventLineAppSimple
, TaggerConfig(..)
, inputTagMap
) where
import Blammo.Logging
import Blammo.Logging.LogSettings.Env as LogSettingsEnv
import Blammo.Logging.Simple
import Control.Monad.IO.Class
import Data.Aeson (decodeStrict')
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BL
import Data.String (IsString (fromString))
import Data.String.Interpolate (i)
import EventDataTheory hiding ((<|>))
import Hasklepias.LineFilterApp.ProcessLines.Logic
import Hasklepias.LineFilterApp.ProcessLines.Taggers
import Hasklepias.LineFilterApp.AppUtilities
import Options.Applicative
import Options.Applicative.Help hiding (fullDesc)
import System.Exit
data LineFilterAppOpts
= MkLineFilterAppOpts
{ LineFilterAppOpts -> Input
input :: !Input
, LineFilterAppOpts -> Output
output :: !Output
, LineFilterAppOpts -> InputDecompression
inDecompress :: !InputDecompression
, LineFilterAppOpts -> OutputCompression
outCompress :: !OutputCompression
, LineFilterAppOpts -> Maybe PartitionIndex
partitionIndex :: !(Maybe PartitionIndex)
}
desc :: Doc
desc :: Doc
desc =
[i|The application takes event data formatted as ndjson (http://ndjson.org/)
(i.e. one event per line). The application returns the event data filtered to
all those subjects who have at least one event satisfying the given predicate.
Each subject's data must be grouped in contiguous chunks of lines; otherwise,
the application may not behave as expected and will not warn or raise an error.
Lines that fail to parse as an `Event` do not satisfy the predicate, but are not
dropped from the output. In other words, all of a subject's data is returned in
the same order as the input, provided that at least one line successfully parses
into an Event c m and satisfies the predicate.
|]
forall a. Semigroup a => a -> a -> a
<> Doc
line
forall a. Semigroup a => a -> a -> a
<> Doc
partitionIndexDoc
forall a. Semigroup a => a -> a -> a
<> Doc
line
makeAppArgs :: String -> ParserInfo LineFilterAppOpts
makeAppArgs :: String -> ParserInfo LineFilterAppOpts
makeAppArgs String
name = forall a. Parser a -> InfoMod a -> ParserInfo a
Options.Applicative.info
( Input
-> Output
-> InputDecompression
-> OutputCompression
-> Maybe PartitionIndex
-> LineFilterAppOpts
MkLineFilterAppOpts
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Input
inputParser
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Output
outputParser
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser InputDecompression
inputDecompressionParser
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser OutputCompression
outputCompressionParser
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser PartitionIndex
partitionIndexParser
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> forall a. Parser (a -> a)
helper
)
(forall a. InfoMod a
fullDesc forall a. Semigroup a => a -> a -> a
<> forall a. Maybe Doc -> InfoMod a
progDescDoc (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Doc
desc forall a. Semigroup a => a -> a -> a
<> Doc
line forall a. Semigroup a => a -> a -> a
<> Doc
logSettingsHelpDoc)
forall a. Semigroup a => a -> a -> a
<> forall a. String -> InfoMod a
header (String
"Filter events for " forall a. Semigroup a => a -> a -> a
<> String
name))
makeLineFilterApp
:: (Eq a, Eq i, Show i, MonadLogger m, MonadIO m)
=> String
-> (BS.ByteString -> Maybe i)
-> (BS.ByteString -> Maybe a)
-> (a -> Bool)
-> m ()
makeLineFilterApp :: forall a i (m :: * -> *).
(Eq a, Eq i, Show i, MonadLogger m, MonadIO m) =>
String
-> (ByteString -> Maybe i)
-> (ByteString -> Maybe a)
-> (a -> Bool)
-> m ()
makeLineFilterApp String
name ByteString -> Maybe i
pid ByteString -> Maybe a
psl a -> Bool
prd = do
LineFilterAppOpts
options <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. ParserInfo a -> IO a
execParser (String -> ParserInfo LineFilterAppOpts
makeAppArgs String
name)
let iospec :: Either PartitionTemplateError IOSpec
iospec = Maybe PartitionIndex
-> Input -> Output -> Either PartitionTemplateError IOSpec
parseIOSpec
(LineFilterAppOpts -> Maybe PartitionIndex
partitionIndex LineFilterAppOpts
options)
(LineFilterAppOpts -> Input
input LineFilterAppOpts
options)
(LineFilterAppOpts -> Output
output LineFilterAppOpts
options)
case Either PartitionTemplateError IOSpec
iospec of
Left PartitionTemplateError
e -> do
forall (m :: * -> *).
(HasCallStack, MonadLogger m) =>
Message -> m ()
logError (forall a. IsString a => String -> a
fromString forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show PartitionTemplateError
e)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. ExitCode -> IO a
exitWith (Int -> ExitCode
ExitFailure Int
1)
Right IOSpec
spec -> do
LineAppMonad ByteString
result <-
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall id a b.
(Eq id, Show id) =>
(ByteString -> Maybe id)
-> (ByteString -> Maybe a)
-> (a -> Bool)
-> LineProcessor a b id
-> ByteString
-> LineAppMonad ByteString
processAppLinesStrict ByteString -> Maybe i
pid ByteString -> Maybe a
psl a -> Bool
prd forall a b id. LineProcessor a b id
NoTransformation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Location -> InputDecompression -> IO ByteString
readDataStrict (IOSpec -> Location
inputLocation IOSpec
spec) (LineFilterAppOpts -> InputDecompression
inDecompress LineFilterAppOpts
options)
case LineAppMonad ByteString
result of
Left LineAppError
lae -> do
forall (m :: * -> *).
(HasCallStack, MonadLogger m) =>
Message -> m ()
logError forall a b. (a -> b) -> a -> b
$ LineAppError -> Message
lineAppErrorMessage LineAppError
lae
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. ExitCode -> IO a
exitWith (Int -> ExitCode
ExitFailure Int
1)
Right ByteString
bs ->
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Location -> OutputCompression -> ByteString -> IO ()
writeDataStrict (IOSpec -> Location
outputLocation IOSpec
spec) (LineFilterAppOpts -> OutputCompression
outCompress LineFilterAppOpts
options) ByteString
bs
runLineFilterAppSimple
:: (Eq a, Eq i, Show i)
=> String
-> (BS.ByteString -> Maybe i)
-> (BS.ByteString -> Maybe a)
-> (a -> Bool)
-> IO ()
runLineFilterAppSimple :: forall a i.
(Eq a, Eq i, Show i) =>
String
-> (ByteString -> Maybe i)
-> (ByteString -> Maybe a)
-> (a -> Bool)
-> IO ()
runLineFilterAppSimple String
name ByteString -> Maybe i
pid ByteString -> Maybe a
psl a -> Bool
prd = do
Logger
logger <- forall (m :: * -> *). MonadIO m => LogSettings -> m Logger
newLogger forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO LogSettings
parseLogSettings
forall (m :: * -> *) env a.
(MonadUnliftIO m, HasLogger env) =>
env -> LoggingT m a -> m a
runLoggerLoggingT Logger
logger forall a b. (a -> b) -> a -> b
$ forall a i (m :: * -> *).
(Eq a, Eq i, Show i, MonadLogger m, MonadIO m) =>
String
-> (ByteString -> Maybe i)
-> (ByteString -> Maybe a)
-> (a -> Bool)
-> m ()
makeLineFilterApp String
name ByteString -> Maybe i
pid ByteString -> Maybe a
psl a -> Bool
prd
makeFilterEventLineApp
:: (Eventable t m a, EventLineAble t m a b, FromJSONEvent t m a, MonadLogger f, MonadIO f)
=> String
-> (Event t m a -> Bool)
-> TaggerConfig t c m
-> f ()
makeFilterEventLineApp :: forall t m a b (f :: * -> *) c.
(Eventable t m a, EventLineAble t m a b, FromJSONEvent t m a,
MonadLogger f, MonadIO f) =>
String -> (Event t m a -> Bool) -> TaggerConfig t c m -> f ()
makeFilterEventLineApp String
name Event t m a -> Bool
es TaggerConfig t c m
_ =
forall a i (m :: * -> *).
(Eq a, Eq i, Show i, MonadLogger m, MonadIO m) =>
String
-> (ByteString -> Maybe i)
-> (ByteString -> Maybe a)
-> (a -> Bool)
-> m ()
makeLineFilterApp
String
name
(forall a. FromJSON a => ByteString -> Maybe a
decodeStrict' @SubjectID)
(forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m t a b.
(Eventable t m a, EventLineAble t m a b, FromJSONEvent t m a) =>
ParseEventLineOption
-> ByteString -> Maybe (SubjectID, Event t m a)
decodeEvent' ParseEventLineOption
defaultParseEventLineOption)
Event t m a -> Bool
es
runFilterEventLineAppSimple
:: (Eventable t m a, EventLineAble t m a b, FromJSONEvent t m a)
=> String
-> (Event t m a -> Bool)
-> IO ()
runFilterEventLineAppSimple :: forall t m a b.
(Eventable t m a, EventLineAble t m a b, FromJSONEvent t m a) =>
String -> (Event t m a -> Bool) -> IO ()
runFilterEventLineAppSimple String
name Event t m a -> Bool
prd = do
Logger
logger <- forall (m :: * -> *). MonadIO m => LogSettings -> m Logger
newLogger forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO LogSettings
parseLogSettings
forall (m :: * -> *) env a.
(MonadUnliftIO m, HasLogger env) =>
env -> LoggingT m a -> m a
runLoggerLoggingT Logger
logger forall a b. (a -> b) -> a -> b
$ forall t m a b (f :: * -> *) c.
(Eventable t m a, EventLineAble t m a b, FromJSONEvent t m a,
MonadLogger f, MonadIO f) =>
String -> (Event t m a -> Bool) -> TaggerConfig t c m -> f ()
makeFilterEventLineApp String
name Event t m a -> Bool
prd forall t m. TaggerConfig t SubjectID m
emptyTaggerConfig