module Sarsi.Processor where

import qualified Codec.GHC.Log as GHC
import Codec.Sarsi (Message)
import Codec.Sarsi.GHC (fromGHCLog)
import qualified Codec.Sarsi.Rust as Rust
import Data.Attoparsec.Text.Machine (streamParser)
import Data.Machine (ProcessT, asParts, auto, flattened, (<~))
import Data.Machine.Fanout (fanout)
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Text (Text)
import Rosetta (LanguageTag (..), ProjectTag, projectLanguages)

data Processor = Processor {Processor -> LanguageTag
language :: LanguageTag, Processor -> ProcessT IO Text Message
process :: ProcessT IO Text Message}

instance Eq Processor where
  Processor
a == :: Processor -> Processor -> Bool
== Processor
b = (Processor -> LanguageTag
language Processor
a) LanguageTag -> LanguageTag -> Bool
forall a. Eq a => a -> a -> Bool
== (Processor -> LanguageTag
language Processor
b)

instance Ord Processor where
  compare :: Processor -> Processor -> Ordering
compare Processor
a Processor
b = LanguageTag -> LanguageTag -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Processor -> LanguageTag
language Processor
a) (Processor -> LanguageTag
language Processor
b)

projectProcessors :: ProjectTag -> Set Processor
-- projectProcessors DOTNET = processDotnet
projectProcessors :: ProjectTag -> Set Processor
projectProcessors ProjectTag
project = [Processor] -> Set Processor
forall a. Ord a => [a] -> Set a
Set.fromList ([Processor] -> Set Processor) -> [Processor] -> Set Processor
forall a b. (a -> b) -> a -> b
$ Maybe (LanguageTag, ProcessT IO Text Message) -> [Processor]
g (Maybe (LanguageTag, ProcessT IO Text Message) -> [Processor])
-> [Maybe (LanguageTag, ProcessT IO Text Message)] -> [Processor]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< LanguageTag -> Maybe (LanguageTag, ProcessT IO Text Message)
f (LanguageTag -> Maybe (LanguageTag, ProcessT IO Text Message))
-> [LanguageTag] -> [Maybe (LanguageTag, ProcessT IO Text Message)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProjectTag -> [LanguageTag]
projectLanguages ProjectTag
project
  where
    f :: LanguageTag -> Maybe (LanguageTag, ProcessT IO Text Message)
f LanguageTag
l = (\ProcessT IO Text Message
p -> (LanguageTag
l, ProcessT IO Text Message
p)) (ProcessT IO Text Message
 -> (LanguageTag, ProcessT IO Text Message))
-> Maybe (ProcessT IO Text Message)
-> Maybe (LanguageTag, ProcessT IO Text Message)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LanguageTag -> Maybe (ProcessT IO Text Message)
languageProcess LanguageTag
l
    g :: Maybe (LanguageTag, ProcessT IO Text Message) -> [Processor]
g (Just (LanguageTag
l, ProcessT IO Text Message
p)) = [Processor :: LanguageTag -> ProcessT IO Text Message -> Processor
Processor {language :: LanguageTag
language = LanguageTag
l, process :: ProcessT IO Text Message
process = ProcessT IO Text Message
p}]
    g Maybe (LanguageTag, ProcessT IO Text Message)
Nothing = []

languageProcess :: LanguageTag -> Maybe (ProcessT IO Text Message)
languageProcess :: LanguageTag -> Maybe (ProcessT IO Text Message)
languageProcess LanguageTag
HS = ProcessT IO Text Message -> Maybe (ProcessT IO Text Message)
forall a. a -> Maybe a
Just ProcessT IO Text Message
processHaskell
languageProcess LanguageTag
RS = ProcessT IO Text Message -> Maybe (ProcessT IO Text Message)
forall a. a -> Maybe a
Just ProcessT IO Text Message
processRust
languageProcess LanguageTag
_ = Maybe (ProcessT IO Text Message)
forall a. Maybe a
Nothing

processAll :: [ProcessT IO Text Message] -> ProcessT IO Text Message
processAll :: [ProcessT IO Text Message] -> ProcessT IO Text Message
processAll [ProcessT IO Text Message]
xs = MachineT IO (Is [Message]) Message
forall (f :: * -> *) a. Foldable f => Process (f a) a
flattened MachineT IO (Is [Message]) Message
-> MachineT IO (Is Text) [Message] -> ProcessT IO Text Message
forall (m :: * -> *) b c (k :: * -> *).
Monad m =>
ProcessT m b c -> MachineT m k b -> MachineT m k c
<~ ([MachineT IO (Is Text) [Message]]
-> MachineT IO (Is Text) [Message]
forall (m :: * -> *) a r.
(Monad m, Semigroup r) =>
[ProcessT m a r] -> ProcessT m a r
fanout ([MachineT IO (Is Text) [Message]]
 -> MachineT IO (Is Text) [Message])
-> [MachineT IO (Is Text) [Message]]
-> MachineT IO (Is Text) [Message]
forall a b. (a -> b) -> a -> b
$ (\ProcessT IO Text Message
p -> ((Message -> [Message]) -> Process Message [Message]
forall (k :: * -> * -> *) a b. Automaton k => k a b -> Process a b
auto (\Message
x -> [Message
x])) MachineT IO (Is Message) [Message]
-> ProcessT IO Text Message -> MachineT IO (Is Text) [Message]
forall (m :: * -> *) b c (k :: * -> *).
Monad m =>
ProcessT m b c -> MachineT m k b -> MachineT m k c
<~ ProcessT IO Text Message
p) (ProcessT IO Text Message -> MachineT IO (Is Text) [Message])
-> [ProcessT IO Text Message] -> [MachineT IO (Is Text) [Message]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ProcessT IO Text Message]
xs)

processAny :: ProcessT IO Text Message
processAny :: ProcessT IO Text Message
processAny = [ProcessT IO Text Message] -> ProcessT IO Text Message
processAll [ProcessT IO Text Message
processHaskell, ProcessT IO Text Message
processRust]

processHaskell :: ProcessT IO Text Message
processHaskell :: ProcessT IO Text Message
processHaskell = MachineT IO (Is [Message]) Message
forall (f :: * -> *) a. Foldable f => Process (f a) a
asParts MachineT IO (Is [Message]) Message
-> MachineT IO (Is Text) [Message] -> ProcessT IO Text Message
forall (m :: * -> *) b c (k :: * -> *).
Monad m =>
ProcessT m b c -> MachineT m k b -> MachineT m k c
<~ (Either String Message -> [Message])
-> Process (Either String Message) [Message]
forall (k :: * -> * -> *) a b. Automaton k => k a b -> Process a b
auto Either String Message -> [Message]
forall a. Either a Message -> [Message]
unpack MachineT IO (Is (Either String Message)) [Message]
-> MachineT IO (Is Text) (Either String Message)
-> MachineT IO (Is Text) [Message]
forall (m :: * -> *) b c (k :: * -> *).
Monad m =>
ProcessT m b c -> MachineT m k b -> MachineT m k c
<~ Parser Message -> MachineT IO (Is Text) (Either String Message)
forall (m :: * -> *) a.
Monad m =>
Parser a -> ProcessT m Text (Either String a)
streamParser Parser Message
GHC.messageParser
  where
    unpack :: Either a Message -> [Message]
unpack (Right Message
msg) = [Message -> Message
fromGHCLog Message
msg]
    unpack (Left a
_) = []

processRust :: ProcessT IO Text Message
processRust :: ProcessT IO Text Message
processRust = MachineT IO (Is [Message]) Message
forall (f :: * -> *) a. Foldable f => Process (f a) a
asParts MachineT IO (Is [Message]) Message
-> MachineT IO (Is Text) [Message] -> ProcessT IO Text Message
forall (m :: * -> *) b c (k :: * -> *).
Monad m =>
ProcessT m b c -> MachineT m k b -> MachineT m k c
<~ (Either String Message -> [Message])
-> Process (Either String Message) [Message]
forall (k :: * -> * -> *) a b. Automaton k => k a b -> Process a b
auto Either String Message -> [Message]
forall a a. Either a a -> [a]
unpack MachineT IO (Is (Either String Message)) [Message]
-> MachineT IO (Is Text) (Either String Message)
-> MachineT IO (Is Text) [Message]
forall (m :: * -> *) b c (k :: * -> *).
Monad m =>
ProcessT m b c -> MachineT m k b -> MachineT m k c
<~ Parser Message -> MachineT IO (Is Text) (Either String Message)
forall (m :: * -> *) a.
Monad m =>
Parser a -> ProcessT m Text (Either String a)
streamParser Parser Message
Rust.messageParser
  where
    unpack :: Either a a -> [a]
unpack (Right a
msg) = [a
msg]
    unpack (Left a
_) = []