module Hix.Managed.Build.NixOutput where

import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.State.Strict (StateT (runStateT), modify', state)
import qualified Data.Aeson as Aeson
import Data.Aeson (FromJSON, Value (String), withObject, (.:), (.:?))
import qualified Data.ByteString.Char8 as ByteString
import qualified Data.Map.Strict as Map
import Data.Map.Strict ((!?))
import qualified Data.Sequence as Seq
import Data.Sequence ((|>))
import Distribution.Compat.CharParsing (
  CharParsing (char, notChar, string),
  Parsing (notFollowedBy, try),
  digit,
  letter,
  lower,
  )
import Distribution.Parsec (Parsec, eitherParsec, parsec)
import Exon (exon)

import Hix.Data.Json (jsonEither)
import Hix.Data.Monad (M)
import qualified Hix.Data.PackageId as PackageId
import Hix.Data.PackageId (PackageId (..))
import qualified Hix.Log as Log
import Hix.Pretty (showP)

data Derivation =
  Derivation {
    Derivation -> Text
path :: Text,
    Derivation -> (Seq Text, Seq Text)
log :: (Seq Text, Seq Text)
  }
  deriving stock (Derivation -> Derivation -> Bool
(Derivation -> Derivation -> Bool)
-> (Derivation -> Derivation -> Bool) -> Eq Derivation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Derivation -> Derivation -> Bool
== :: Derivation -> Derivation -> Bool
$c/= :: Derivation -> Derivation -> Bool
/= :: Derivation -> Derivation -> Bool
Eq, Int -> Derivation -> ShowS
[Derivation] -> ShowS
Derivation -> String
(Int -> Derivation -> ShowS)
-> (Derivation -> String)
-> ([Derivation] -> ShowS)
-> Show Derivation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Derivation -> ShowS
showsPrec :: Int -> Derivation -> ShowS
$cshow :: Derivation -> String
show :: Derivation -> String
$cshowList :: [Derivation] -> ShowS
showList :: [Derivation] -> ShowS
Show, (forall x. Derivation -> Rep Derivation x)
-> (forall x. Rep Derivation x -> Derivation) -> Generic Derivation
forall x. Rep Derivation x -> Derivation
forall x. Derivation -> Rep Derivation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Derivation -> Rep Derivation x
from :: forall x. Derivation -> Rep Derivation x
$cto :: forall x. Rep Derivation x -> Derivation
to :: forall x. Rep Derivation x -> Derivation
Generic)

data PackageDerivation =
  PackageDerivation {
    PackageDerivation -> PackageId
package :: PackageId,
    PackageDerivation -> Bool
success :: Bool,
    PackageDerivation -> [Text]
log :: [Text]
  }
  deriving stock (PackageDerivation -> PackageDerivation -> Bool
(PackageDerivation -> PackageDerivation -> Bool)
-> (PackageDerivation -> PackageDerivation -> Bool)
-> Eq PackageDerivation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PackageDerivation -> PackageDerivation -> Bool
== :: PackageDerivation -> PackageDerivation -> Bool
$c/= :: PackageDerivation -> PackageDerivation -> Bool
/= :: PackageDerivation -> PackageDerivation -> Bool
Eq, Int -> PackageDerivation -> ShowS
[PackageDerivation] -> ShowS
PackageDerivation -> String
(Int -> PackageDerivation -> ShowS)
-> (PackageDerivation -> String)
-> ([PackageDerivation] -> ShowS)
-> Show PackageDerivation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PackageDerivation -> ShowS
showsPrec :: Int -> PackageDerivation -> ShowS
$cshow :: PackageDerivation -> String
show :: PackageDerivation -> String
$cshowList :: [PackageDerivation] -> ShowS
showList :: [PackageDerivation] -> ShowS
Show, (forall x. PackageDerivation -> Rep PackageDerivation x)
-> (forall x. Rep PackageDerivation x -> PackageDerivation)
-> Generic PackageDerivation
forall x. Rep PackageDerivation x -> PackageDerivation
forall x. PackageDerivation -> Rep PackageDerivation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PackageDerivation -> Rep PackageDerivation x
from :: forall x. PackageDerivation -> Rep PackageDerivation x
$cto :: forall x. Rep PackageDerivation x -> PackageDerivation
to :: forall x. Rep PackageDerivation x -> PackageDerivation
Generic)

data BuildsState =
  BuildsState {
    BuildsState -> Integer
id :: Integer,
    BuildsState -> Int
done :: Int,
    BuildsState -> Int
failed :: Int,
    BuildsState -> [Bool]
unassigned :: [Bool]
  }
  deriving stock (BuildsState -> BuildsState -> Bool
(BuildsState -> BuildsState -> Bool)
-> (BuildsState -> BuildsState -> Bool) -> Eq BuildsState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BuildsState -> BuildsState -> Bool
== :: BuildsState -> BuildsState -> Bool
$c/= :: BuildsState -> BuildsState -> Bool
/= :: BuildsState -> BuildsState -> Bool
Eq, Int -> BuildsState -> ShowS
[BuildsState] -> ShowS
BuildsState -> String
(Int -> BuildsState -> ShowS)
-> (BuildsState -> String)
-> ([BuildsState] -> ShowS)
-> Show BuildsState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BuildsState -> ShowS
showsPrec :: Int -> BuildsState -> ShowS
$cshow :: BuildsState -> String
show :: BuildsState -> String
$cshowList :: [BuildsState] -> ShowS
showList :: [BuildsState] -> ShowS
Show, (forall x. BuildsState -> Rep BuildsState x)
-> (forall x. Rep BuildsState x -> BuildsState)
-> Generic BuildsState
forall x. Rep BuildsState x -> BuildsState
forall x. BuildsState -> Rep BuildsState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. BuildsState -> Rep BuildsState x
from :: forall x. BuildsState -> Rep BuildsState x
$cto :: forall x. Rep BuildsState x -> BuildsState
to :: forall x. Rep BuildsState x -> BuildsState
Generic)

data OutputState =
  OutputState {
    OutputState -> Maybe BuildsState
builds :: Maybe BuildsState,
    OutputState -> Map Integer Derivation
running :: Map Integer Derivation,
    OutputState -> [PackageDerivation]
finished :: [PackageDerivation]
  }
  deriving stock (OutputState -> OutputState -> Bool
(OutputState -> OutputState -> Bool)
-> (OutputState -> OutputState -> Bool) -> Eq OutputState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OutputState -> OutputState -> Bool
== :: OutputState -> OutputState -> Bool
$c/= :: OutputState -> OutputState -> Bool
/= :: OutputState -> OutputState -> Bool
Eq, Int -> OutputState -> ShowS
[OutputState] -> ShowS
OutputState -> String
(Int -> OutputState -> ShowS)
-> (OutputState -> String)
-> ([OutputState] -> ShowS)
-> Show OutputState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OutputState -> ShowS
showsPrec :: Int -> OutputState -> ShowS
$cshow :: OutputState -> String
show :: OutputState -> String
$cshowList :: [OutputState] -> ShowS
showList :: [OutputState] -> ShowS
Show, (forall x. OutputState -> Rep OutputState x)
-> (forall x. Rep OutputState x -> OutputState)
-> Generic OutputState
forall x. Rep OutputState x -> OutputState
forall x. OutputState -> Rep OutputState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. OutputState -> Rep OutputState x
from :: forall x. OutputState -> Rep OutputState x
$cto :: forall x. Rep OutputState x -> OutputState
to :: forall x. Rep OutputState x -> OutputState
Generic)
  deriving anyclass (OutputState
OutputState -> Default OutputState
forall a. a -> Default a
$cdef :: OutputState
def :: OutputState
Default)

data OutputResult =
  OutputResult {
    OutputResult -> Maybe (NonEmpty PackageDerivation)
failedPackages :: Maybe (NonEmpty PackageDerivation)
  }
  deriving stock (OutputResult -> OutputResult -> Bool
(OutputResult -> OutputResult -> Bool)
-> (OutputResult -> OutputResult -> Bool) -> Eq OutputResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OutputResult -> OutputResult -> Bool
== :: OutputResult -> OutputResult -> Bool
$c/= :: OutputResult -> OutputResult -> Bool
/= :: OutputResult -> OutputResult -> Bool
Eq, Int -> OutputResult -> ShowS
[OutputResult] -> ShowS
OutputResult -> String
(Int -> OutputResult -> ShowS)
-> (OutputResult -> String)
-> ([OutputResult] -> ShowS)
-> Show OutputResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OutputResult -> ShowS
showsPrec :: Int -> OutputResult -> ShowS
$cshow :: OutputResult -> String
show :: OutputResult -> String
$cshowList :: [OutputResult] -> ShowS
showList :: [OutputResult] -> ShowS
Show, (forall x. OutputResult -> Rep OutputResult x)
-> (forall x. Rep OutputResult x -> OutputResult)
-> Generic OutputResult
forall x. Rep OutputResult x -> OutputResult
forall x. OutputResult -> Rep OutputResult x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. OutputResult -> Rep OutputResult x
from :: forall x. OutputResult -> Rep OutputResult x
$cto :: forall x. Rep OutputResult x -> OutputResult
to :: forall x. Rep OutputResult x -> OutputResult
Generic)

outputResult :: OutputState -> OutputResult
outputResult :: OutputState -> OutputResult
outputResult OutputState {[PackageDerivation]
finished :: OutputState -> [PackageDerivation]
finished :: [PackageDerivation]
finished} =
  OutputResult {failedPackages :: Maybe (NonEmpty PackageDerivation)
failedPackages = [PackageDerivation] -> Maybe (NonEmpty PackageDerivation)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty ((PackageDerivation -> Bool)
-> [PackageDerivation] -> [PackageDerivation]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> (PackageDerivation -> Bool) -> PackageDerivation -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.success)) [PackageDerivation]
finished)}

runOutputState ::
  Monad m =>
  StateT OutputState m a ->
  m (a, OutputResult)
runOutputState :: forall (m :: * -> *) a.
Monad m =>
StateT OutputState m a -> m (a, OutputResult)
runOutputState StateT OutputState m a
ma =
  (OutputState -> OutputResult)
-> (a, OutputState) -> (a, OutputResult)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second OutputState -> OutputResult
outputResult ((a, OutputState) -> (a, OutputResult))
-> m (a, OutputState) -> m (a, OutputResult)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT OutputState m a -> OutputState -> m (a, OutputState)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT StateT OutputState m a
ma OutputState
forall a. Default a => a
def

data NixAction =
  NixResult { NixAction -> Integer
aid :: Integer, NixAction -> Int
rtype :: Int, NixAction -> [Either Text Int]
fields :: [Either Text Int] }
  |
  NixStartBuilds Integer
  |
  NixStart Integer Text
  |
  NixStop Integer
  |
  NixStartOther Integer
  |
  NixMessage
  deriving stock (NixAction -> NixAction -> Bool
(NixAction -> NixAction -> Bool)
-> (NixAction -> NixAction -> Bool) -> Eq NixAction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NixAction -> NixAction -> Bool
== :: NixAction -> NixAction -> Bool
$c/= :: NixAction -> NixAction -> Bool
/= :: NixAction -> NixAction -> Bool
Eq, Int -> NixAction -> ShowS
[NixAction] -> ShowS
NixAction -> String
(Int -> NixAction -> ShowS)
-> (NixAction -> String)
-> ([NixAction] -> ShowS)
-> Show NixAction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NixAction -> ShowS
showsPrec :: Int -> NixAction -> ShowS
$cshow :: NixAction -> String
show :: NixAction -> String
$cshowList :: [NixAction] -> ShowS
showList :: [NixAction] -> ShowS
Show, (forall x. NixAction -> Rep NixAction x)
-> (forall x. Rep NixAction x -> NixAction) -> Generic NixAction
forall x. Rep NixAction x -> NixAction
forall x. NixAction -> Rep NixAction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NixAction -> Rep NixAction x
from :: forall x. NixAction -> Rep NixAction x
$cto :: forall x. Rep NixAction x -> NixAction
to :: forall x. Rep NixAction x -> NixAction
Generic)

instance FromJSON NixAction where
  parseJSON :: Value -> Parser NixAction
parseJSON =
    String -> (Object -> Parser NixAction) -> Value -> Parser NixAction
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"NixOutput" \ Object
o ->
      Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"action" Parser Text -> (Text -> Parser NixAction) -> Parser NixAction
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Text
"result" -> do
          Integer
aid <- Object
o Object -> Key -> Parser Integer
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
          Int
rtype <- Object
o Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
          [Either Text Int]
fields <- (JsonEither Text Int -> Either Text Int)
-> [JsonEither Text Int] -> [Either Text Int]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap JsonEither Text Int -> Either Text Int
forall a b. JsonEither a b -> Either a b
jsonEither ([JsonEither Text Int] -> [Either Text Int])
-> Parser [JsonEither Text Int] -> Parser [Either Text Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser [JsonEither Text Int]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"fields"
          pure NixResult {Int
Integer
[Either Text Int]
aid :: Integer
rtype :: Int
fields :: [Either Text Int]
aid :: Integer
rtype :: Int
fields :: [Either Text Int]
..}
        Text
"start" -> do
          Integer
i <- Object
o Object -> Key -> Parser Integer
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
          Object
o Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"type" Parser (Maybe Int)
-> (Maybe Int -> Parser NixAction) -> Parser NixAction
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Just (Int
105 :: Int) ->
              Object
o Object -> Key -> Parser [Value]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"fields" Parser [Value] -> ([Value] -> Parser NixAction) -> Parser NixAction
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                String Text
path : [Value]
_ -> NixAction -> Parser NixAction
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> Text -> NixAction
NixStart Integer
i Text
path)
                [Value]
_ -> NixAction -> Parser NixAction
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> NixAction
NixStartOther Integer
i)
            Just Int
104 ->
              NixAction -> Parser NixAction
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> NixAction
NixStartBuilds Integer
i)
            Maybe Int
_ -> NixAction -> Parser NixAction
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> NixAction
NixStartOther Integer
i)
        Text
"stop" -> do
          Integer
i <- Object
o Object -> Key -> Parser Integer
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
          pure (Integer -> NixAction
NixStop Integer
i)
        Text
"msg" -> NixAction -> Parser NixAction
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NixAction
NixMessage
        (Text
act :: Text) -> String -> Parser NixAction
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail [exon|Unknown action: #{toString act}|]

parseError :: String -> StateT s M ()
parseError :: forall s. String -> StateT s M ()
parseError String
err =
  M () -> StateT s M ()
forall (m :: * -> *) a. Monad m => m a -> StateT s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (M () -> StateT s M ()) -> M () -> StateT s M ()
forall a b. (a -> b) -> a -> b
$ Text -> M ()
Log.debug [exon|Nix output message parse error: #{toText err}|]

newtype StorePathName =
  StorePathName String
  deriving stock (StorePathName -> StorePathName -> Bool
(StorePathName -> StorePathName -> Bool)
-> (StorePathName -> StorePathName -> Bool) -> Eq StorePathName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StorePathName -> StorePathName -> Bool
== :: StorePathName -> StorePathName -> Bool
$c/= :: StorePathName -> StorePathName -> Bool
/= :: StorePathName -> StorePathName -> Bool
Eq, Int -> StorePathName -> ShowS
[StorePathName] -> ShowS
StorePathName -> String
(Int -> StorePathName -> ShowS)
-> (StorePathName -> String)
-> ([StorePathName] -> ShowS)
-> Show StorePathName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StorePathName -> ShowS
showsPrec :: Int -> StorePathName -> ShowS
$cshow :: StorePathName -> String
show :: StorePathName -> String
$cshowList :: [StorePathName] -> ShowS
showList :: [StorePathName] -> ShowS
Show, (forall x. StorePathName -> Rep StorePathName x)
-> (forall x. Rep StorePathName x -> StorePathName)
-> Generic StorePathName
forall x. Rep StorePathName x -> StorePathName
forall x. StorePathName -> Rep StorePathName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. StorePathName -> Rep StorePathName x
from :: forall x. StorePathName -> Rep StorePathName x
$cto :: forall x. Rep StorePathName x -> StorePathName
to :: forall x. Rep StorePathName x -> StorePathName
Generic)

instance Parsec StorePathName where
  parsec :: forall (m :: * -> *). CabalParsing m => m StorePathName
parsec = do
    String -> m String
forall (m :: * -> *). CharParsing m => String -> m String
string String
"/nix/store/"
    m Char -> m String
forall a. m a -> m [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (m Char
forall (m :: * -> *). CharParsing m => m Char
lower m Char -> m Char -> m Char
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m Char
forall (m :: * -> *). CharParsing m => m Char
digit)
    Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
char Char
'-'
    String
pid0 <- m Char -> m String
forall a. m a -> m [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
notChar Char
'.')
    String
pid <- m Char -> m String
forall a. m a -> m [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
notChar Char
'.' m Char -> m Char -> m Char
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (m Char -> m Char
forall a. m a -> m a
forall (m :: * -> *) a. Parsing m => m a -> m a
try (Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
char Char
'.' m Char -> m () -> m Char
forall a b. m a -> m b -> m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* m Char -> m ()
forall a. Show a => m a -> m ()
forall (m :: * -> *) a. (Parsing m, Show a) => m a -> m ()
notFollowedBy m Char
forall (m :: * -> *). CharParsing m => m Char
letter)))
    String -> m String
forall (m :: * -> *). CharParsing m => String -> m String
string String
".drv"
    pure (String -> StorePathName
StorePathName (String
pid0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
pid))

addLogMessage :: Text -> Derivation -> Derivation
addLogMessage :: Text -> Derivation -> Derivation
addLogMessage Text
message Derivation {log :: Derivation -> (Seq Text, Seq Text)
log = (Seq Text
current, Seq Text
prev), Text
path :: Derivation -> Text
path :: Text
..} =
  Derivation {log :: (Seq Text, Seq Text)
log = (Seq Text, Seq Text)
updated, Text
path :: Text
path :: Text
..}
  where
    updated :: (Seq Text, Seq Text)
updated | Seq Text -> Int
forall a. Seq a -> Int
Seq.length Seq Text
current Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
100 = (Text -> Seq Text
forall a. a -> Seq a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
message, Seq Text
current)
            | Bool
otherwise = (Seq Text
current Seq Text -> Text -> Seq Text
forall a. Seq a -> a -> Seq a
|> Text
message, Seq Text
prev)

finish :: Bool -> Derivation -> Either String PackageDerivation
finish :: Bool -> Derivation -> Either String PackageDerivation
finish Bool
success Derivation {Text
path :: Derivation -> Text
path :: Text
path, log :: Derivation -> (Seq Text, Seq Text)
log = (Seq Text
current, Seq Text
prev)} = do
  StorePathName String
name <- String -> Either String StorePathName
forall a. Parsec a => String -> Either String a
eitherParsec (Text -> String
forall a. ToString a => a -> String
toString Text
path)
  PackageId
package <- PackageIdentifier -> PackageId
PackageId.fromCabal (PackageIdentifier -> PackageId)
-> Either String PackageIdentifier -> Either String PackageId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Either String PackageIdentifier
forall a. Parsec a => String -> Either String a
eitherParsec String
name
  pure PackageDerivation {PackageId
package :: PackageId
package :: PackageId
package, Bool
success :: Bool
success :: Bool
success, log :: [Text]
log = Seq Text -> [Text]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Seq Text
prev Seq Text -> Seq Text -> Seq Text
forall a. Semigroup a => a -> a -> a
<> Seq Text
current)}

tryFinish ::
  Maybe BuildsState ->
  Maybe Derivation ->
  (Maybe (Either Derivation PackageDerivation), [PackageDerivation], Maybe BuildsState)
tryFinish :: Maybe BuildsState
-> Maybe Derivation
-> (Maybe (Either Derivation PackageDerivation),
    [PackageDerivation], Maybe BuildsState)
tryFinish Maybe BuildsState
builds = \case
  Maybe Derivation
Nothing -> (Maybe (Either Derivation PackageDerivation)
forall a. Maybe a
Nothing, [], Maybe BuildsState
builds)
  Just Derivation
drv ->
    case Bool -> Derivation -> Either String PackageDerivation
finish Bool
success Derivation
drv of
      Right PackageDerivation
pkg -> (Either Derivation PackageDerivation
-> Maybe (Either Derivation PackageDerivation)
forall a. a -> Maybe a
Just (PackageDerivation -> Either Derivation PackageDerivation
forall a b. b -> Either a b
Right PackageDerivation
pkg), [Item [PackageDerivation]
PackageDerivation
pkg], Maybe BuildsState
newBuilds)
      Left String
_ -> (Either Derivation PackageDerivation
-> Maybe (Either Derivation PackageDerivation)
forall a. a -> Maybe a
Just (Derivation -> Either Derivation PackageDerivation
forall a b. a -> Either a b
Left Derivation
drv), [], Maybe BuildsState
newBuilds)
  where
    (Bool
success, Maybe BuildsState
newBuilds) = case Maybe BuildsState
builds of
      Just s :: BuildsState
s@BuildsState {unassigned :: BuildsState -> [Bool]
unassigned = Bool
h : [Bool]
t} ->
        (Bool
h, BuildsState -> Maybe BuildsState
forall a. a -> Maybe a
Just BuildsState
s {unassigned = t})
      Maybe BuildsState
_ ->
        (Bool
False, Maybe BuildsState
builds)

reportFinished :: Either Derivation PackageDerivation -> StateT OutputState M ()
reportFinished :: Either Derivation PackageDerivation -> StateT OutputState M ()
reportFinished Either Derivation PackageDerivation
result =
  M () -> StateT OutputState M ()
forall (m :: * -> *) a. Monad m => m a -> StateT OutputState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (M () -> StateT OutputState M ())
-> M () -> StateT OutputState M ()
forall a b. (a -> b) -> a -> b
$ Text -> M ()
Log.debug [exon|Nix build of #{desc} #{status}|]
  where
    (Text
desc, Text
status) = case Either Derivation PackageDerivation
result of
      Right PackageDerivation {PackageId
package :: PackageDerivation -> PackageId
package :: PackageId
package, Bool
success :: PackageDerivation -> Bool
success :: Bool
success} -> (PackageId -> Text
forall b a. (Pretty a, IsString b) => a -> b
showP PackageId
package, if Bool
success then Text
"succeeded" else Text
"failed")
      Left Derivation {Text
path :: Derivation -> Text
path :: Text
path} -> (Text
path, Text
"finished with unknown status")

updateBuilds :: [Either Text Int] -> OutputState -> OutputState
updateBuilds :: [Either Text Int] -> OutputState -> OutputState
updateBuilds [Right Int
updatedDone, Item [Either Text Int]
_, Item [Either Text Int]
_, Right Int
updatedFailed] s :: OutputState
s@OutputState {builds :: OutputState -> Maybe BuildsState
builds = Just bs :: BuildsState
bs@BuildsState {Int
done :: BuildsState -> Int
done :: Int
done, Int
failed :: BuildsState -> Int
failed :: Int
failed, [Bool]
unassigned :: BuildsState -> [Bool]
unassigned :: [Bool]
unassigned}}
  | Int
newDone Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
  , Int
newFailed Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
  = OutputState
s {builds = Just newBs {unassigned = unassigned ++ replicate newDone True}}
  | Int
newFailed Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
  , Int
newDone Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
  = OutputState
s {builds = Just newBs {unassigned = unassigned ++ replicate newFailed False}}
  where
    newBs :: BuildsState
newBs = BuildsState
bs {done = updatedDone, failed = updatedFailed}
    newDone :: Int
newDone = Int
updatedDone Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
done
    newFailed :: Int
newFailed = Int
updatedFailed Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
failed
updateBuilds [Either Text Int]
_ OutputState
s = OutputState
s

processResult :: Integer -> Int -> [Either Text Int] -> OutputState -> OutputState
processResult :: Integer -> Int -> [Either Text Int] -> OutputState -> OutputState
processResult Integer
aid Int
rtype [Either Text Int]
fields OutputState
s
  | Int
rtype Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
105
  , Just BuildsState {id :: BuildsState -> Integer
id = Integer
buildsId} <- OutputState
s.builds
  , Integer
aid Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
buildsId
  = [Either Text Int] -> OutputState -> OutputState
updateBuilds [Either Text Int]
fields OutputState
s
  | Int
rtype Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
101
  , Left Text
message : [Either Text Int]
_ <- [Either Text Int]
fields
  = OutputState
s {running = Map.adjust (addLogMessage message) aid s.running}
  | Bool
otherwise
  = OutputState
s

processMessage ::
  ByteString ->
  NixAction ->
  StateT OutputState M ()
processMessage :: ByteString -> NixAction -> StateT OutputState M ()
processMessage ByteString
_ = \case
  NixResult {Integer
aid :: NixAction -> Integer
aid :: Integer
aid, Int
rtype :: NixAction -> Int
rtype :: Int
rtype, [Either Text Int]
fields :: NixAction -> [Either Text Int]
fields :: [Either Text Int]
fields} -> do
    -- lift (Log.debug (decodeUtf8 payload))
    (OutputState -> OutputState) -> StateT OutputState M ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify' (Integer -> Int -> [Either Text Int] -> OutputState -> OutputState
processResult Integer
aid Int
rtype [Either Text Int]
fields)
  NixStartBuilds Integer
i -> (OutputState -> OutputState) -> StateT OutputState M ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify' \ OutputState
s -> OutputState
s {builds = Just BuildsState {id = i, done = 0, failed = 0, unassigned = []}}
  NixStart Integer
i Text
path -> do
    M () -> StateT OutputState M ()
forall (m :: * -> *) a. Monad m => m a -> StateT OutputState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (M () -> StateT OutputState M ())
-> M () -> StateT OutputState M ()
forall a b. (a -> b) -> a -> b
$ Text -> M ()
Log.debug [exon|Started build of #{path} (#{show i})|]
    (OutputState -> OutputState) -> StateT OutputState M ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify' \ OutputState {Map Integer Derivation
running :: OutputState -> Map Integer Derivation
running :: Map Integer Derivation
running, [PackageDerivation]
Maybe BuildsState
builds :: OutputState -> Maybe BuildsState
finished :: OutputState -> [PackageDerivation]
builds :: Maybe BuildsState
finished :: [PackageDerivation]
..} ->
      OutputState {running :: Map Integer Derivation
running = Integer
-> Derivation -> Map Integer Derivation -> Map Integer Derivation
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Integer
i (Text -> (Seq Text, Seq Text) -> Derivation
Derivation Text
path (Seq Text, Seq Text)
forall a. Monoid a => a
mempty) Map Integer Derivation
running, [PackageDerivation]
Maybe BuildsState
builds :: Maybe BuildsState
finished :: [PackageDerivation]
builds :: Maybe BuildsState
finished :: [PackageDerivation]
..}
  NixStop Integer
i -> do
    Maybe (Either Derivation PackageDerivation)
result <- (OutputState
 -> (Maybe (Either Derivation PackageDerivation), OutputState))
-> StateT
     OutputState M (Maybe (Either Derivation PackageDerivation))
forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state \ OutputState {Map Integer Derivation
running :: OutputState -> Map Integer Derivation
running :: Map Integer Derivation
running, [PackageDerivation]
Maybe BuildsState
builds :: OutputState -> Maybe BuildsState
finished :: OutputState -> [PackageDerivation]
builds :: Maybe BuildsState
finished :: [PackageDerivation]
..} -> do
      let (Maybe (Either Derivation PackageDerivation)
result, [PackageDerivation]
package, Maybe BuildsState
newBuilds) = Maybe BuildsState
-> Maybe Derivation
-> (Maybe (Either Derivation PackageDerivation),
    [PackageDerivation], Maybe BuildsState)
tryFinish Maybe BuildsState
builds (Map Integer Derivation
running Map Integer Derivation -> Integer -> Maybe Derivation
forall k a. Ord k => Map k a -> k -> Maybe a
!? Integer
i)
      (Maybe (Either Derivation PackageDerivation)
result, OutputState {running :: Map Integer Derivation
running = Integer -> Map Integer Derivation -> Map Integer Derivation
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete Integer
i Map Integer Derivation
running, finished :: [PackageDerivation]
finished = [PackageDerivation]
finished [PackageDerivation] -> [PackageDerivation] -> [PackageDerivation]
forall a. [a] -> [a] -> [a]
++ [PackageDerivation]
package, builds :: Maybe BuildsState
builds = Maybe BuildsState
newBuilds, ..})
    (Either Derivation PackageDerivation -> StateT OutputState M ())
-> Maybe (Either Derivation PackageDerivation)
-> StateT OutputState M ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Either Derivation PackageDerivation -> StateT OutputState M ()
reportFinished Maybe (Either Derivation PackageDerivation)
result
  NixStartOther Integer
_ -> StateT OutputState M ()
forall (f :: * -> *). Applicative f => f ()
unit
  NixAction
NixMessage -> StateT OutputState M ()
forall (f :: * -> *). Applicative f => f ()
unit

outputParse :: ByteString -> StateT OutputState M ()
outputParse :: ByteString -> StateT OutputState M ()
outputParse ByteString
outputLine
  | Just ByteString
payload <- ByteString -> ByteString -> Maybe ByteString
ByteString.stripPrefix ByteString
"@nix " ByteString
outputLine
  = (String -> StateT OutputState M ())
-> (NixAction -> StateT OutputState M ())
-> Either String NixAction
-> StateT OutputState M ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> StateT OutputState M ()
forall s. String -> StateT s M ()
parseError (ByteString -> NixAction -> StateT OutputState M ()
processMessage ByteString
payload) (ByteString -> Either String NixAction
forall a. FromJSON a => ByteString -> Either String a
Aeson.eitherDecodeStrict' ByteString
payload)
  | Bool
otherwise
  = M () -> StateT OutputState M ()
forall (m :: * -> *) a. Monad m => m a -> StateT OutputState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Text -> M ()
Log.debug (ByteString -> Text
forall a b. ConvertUtf8 a b => b -> a
decodeUtf8 ByteString
outputLine))