{-# LANGUAGE OverloadedStrings #-}

module Hydra.Sources.Tier3.Tier3 where

-- Standard Tier-3 imports
import           Prelude hiding ((++))
import qualified Data.List                 as L
import qualified Data.Map                  as M
import qualified Data.Set                  as S
import qualified Data.Maybe                as Y
import           Hydra.Dsl.Base            as Base
import qualified Hydra.Dsl.Core            as Core
import qualified Hydra.Dsl.Graph           as Graph
import qualified Hydra.Dsl.Lib.Equality    as Equality
import qualified Hydra.Dsl.Lib.Flows       as Flows
import qualified Hydra.Dsl.Lib.Io          as Io
import qualified Hydra.Dsl.Lib.Lists       as Lists
import qualified Hydra.Dsl.Lib.Literals    as Literals
import qualified Hydra.Dsl.Lib.Logic       as Logic
import qualified Hydra.Dsl.Lib.Maps        as Maps
import qualified Hydra.Dsl.Lib.Math        as Math
import qualified Hydra.Dsl.Lib.Optionals   as Optionals
import qualified Hydra.Dsl.Lib.Sets        as Sets
import           Hydra.Dsl.Lib.Strings     as Strings
import qualified Hydra.Dsl.Module          as Module
import qualified Hydra.Dsl.Terms           as Terms
import qualified Hydra.Dsl.Types           as Types
import           Hydra.Sources.Tier2.All


tier3Definition :: String -> TTerm a -> TElement a
tier3Definition :: forall a. String -> TTerm a -> TElement a
tier3Definition = Module -> String -> TTerm a -> TElement a
forall a. Module -> String -> TTerm a -> TElement a
definitionInModule Module
hydraTier3Module

-- TODO: this need not be a tier-3 module; it has no term-level dependencies. It could be a tier-1 module.
hydraTier3Module :: Module
hydraTier3Module :: Module
hydraTier3Module = Namespace
-> [Element] -> [Module] -> [Module] -> Maybe String -> Module
Module (String -> Namespace
Namespace String
"hydra/tier3") [Element]
elements [Module
hydraCoreModule] [Module]
tier0Modules (Maybe String -> Module) -> Maybe String -> Module
forall a b. (a -> b) -> a -> b
$
    String -> Maybe String
forall a. a -> Maybe a
Just (String
"A module for miscellaneous tier-3 functions and constants.")
  where
   elements :: [Element]
elements = [
     TElement (Trace -> String) -> Element
forall a. TElement a -> Element
el TElement (Trace -> String)
traceSummaryDef
     ]

traceSummaryDef :: TElement (Trace -> String)
traceSummaryDef :: TElement (Trace -> String)
traceSummaryDef = String -> TTerm (Trace -> String) -> TElement (Trace -> String)
forall a. String -> TTerm a -> TElement a
tier3Definition String
"traceSummary" (TTerm (Trace -> String) -> TElement (Trace -> String))
-> TTerm (Trace -> String) -> TElement (Trace -> String)
forall a b. (a -> b) -> a -> b
$
  String -> TTerm (Trace -> String) -> TTerm (Trace -> String)
forall a. String -> TTerm a -> TTerm a
doc String
"Summarize a trace as a string" (TTerm (Trace -> String) -> TTerm (Trace -> String))
-> TTerm (Trace -> String) -> TTerm (Trace -> String)
forall a b. (a -> b) -> a -> b
$
  Type -> Type -> TTerm (Trace -> String) -> TTerm (Trace -> String)
forall a. Type -> Type -> TTerm a -> TTerm a
function Type
traceT Type
stringT (TTerm (Trace -> String) -> TTerm (Trace -> String))
-> TTerm (Trace -> String) -> TTerm (Trace -> String)
forall a b. (a -> b) -> a -> b
$
  String -> TTerm String -> TTerm (Trace -> String)
forall x a b. String -> TTerm x -> TTerm (a -> b)
lambda String
"t" (TTerm String -> TTerm (Trace -> String))
-> TTerm String -> TTerm (Trace -> String)
forall a b. (a -> b) -> a -> b
$ (
    (TTerm (String -> [String] -> String)
Strings.intercalate TTerm (String -> [String] -> String)
-> TTerm String -> TTerm ([String] -> String)
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ TTerm String
"\n" TTerm ([String] -> String) -> TTerm [String] -> TTerm String
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ (TTerm ([String] -> [String] -> [String])
forall a. TTerm ([a] -> [a] -> [a])
Lists.concat2 TTerm ([String] -> [String] -> [String])
-> TTerm [String] -> TTerm ([String] -> [String])
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ String -> TTerm [String]
forall a. String -> TTerm a
var String
"messageLines" TTerm ([String] -> [String]) -> TTerm [String] -> TTerm [String]
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ String -> TTerm [String]
forall a. String -> TTerm a
var String
"keyvalLines"))
      TTerm String -> [Field] -> TTerm String
forall a. TTerm a -> [Field] -> TTerm a
`with` [
        String
"messageLines"String -> TTerm [String] -> Field
forall a. String -> TTerm a -> Field
>: (TTerm ([String] -> [String])
forall a. Eq a => TTerm ([a] -> [a])
Lists.nub TTerm ([String] -> [String]) -> TTerm [String] -> TTerm [String]
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ (TTerm (Trace -> [String])
Flows.traceMessages TTerm (Trace -> [String]) -> TTerm Trace -> TTerm [String]
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ String -> TTerm Trace
forall a. String -> TTerm a
var String
"t")),
        String
"keyvalLines"String -> TTerm [Any] -> Field
forall a. String -> TTerm a -> Field
>: TTerm ([Any] -> [Any] -> Bool -> [Any])
forall a. TTerm (a -> a -> Bool -> a)
Logic.ifElse
          TTerm ([Any] -> [Any] -> Bool -> [Any])
-> TTerm [Any] -> TTerm ([Any] -> Bool -> [Any])
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ ([TTerm Any] -> TTerm [Any]
forall a. [TTerm a] -> TTerm [a]
list [])
          TTerm ([Any] -> Bool -> [Any])
-> TTerm [Any] -> TTerm (Bool -> [Any])
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ (TTerm (Any -> [Any] -> [Any])
forall a. TTerm (a -> [a] -> [a])
Lists.cons TTerm (Any -> [Any] -> [Any])
-> TTerm Any -> TTerm ([Any] -> [Any])
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ TTerm Any
"key/value pairs: "
            TTerm ([Any] -> [Any]) -> TTerm [Any] -> TTerm [Any]
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ (TTerm (((String, Term) -> Any) -> [(String, Term)] -> [Any])
forall a b. TTerm ((a -> b) -> [a] -> [b])
Lists.map TTerm (((String, Term) -> Any) -> [(String, Term)] -> [Any])
-> TTerm ((String, Term) -> Any)
-> TTerm ([(String, Term)] -> [Any])
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ (String -> TTerm ((String, Term) -> Any)
forall a. String -> TTerm a
var String
"toLine") TTerm ([(String, Term)] -> [Any])
-> TTerm [(String, Term)] -> TTerm [Any]
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ (TTerm (Map String Term -> [(String, Term)])
forall k v. TTerm (Map k v -> [(k, v)])
Maps.toList TTerm (Map String Term -> [(String, Term)])
-> TTerm (Map String Term) -> TTerm [(String, Term)]
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ (TTerm (Trace -> Map String Term)
Flows.traceOther TTerm (Trace -> Map String Term)
-> TTerm Trace -> TTerm (Map String Term)
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ String -> TTerm Trace
forall a. String -> TTerm a
var String
"t"))))
          TTerm (Bool -> [Any]) -> TTerm Bool -> TTerm [Any]
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ (TTerm (Map String Term -> Bool)
forall k v. TTerm (Map k v -> Bool)
Maps.isEmpty TTerm (Map String Term -> Bool)
-> TTerm (Map String Term) -> TTerm Bool
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ (TTerm (Trace -> Map String Term)
Flows.traceOther TTerm (Trace -> Map String Term)
-> TTerm Trace -> TTerm (Map String Term)
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ String -> TTerm Trace
forall a. String -> TTerm a
var String
"t")),
        String
"toLine"String -> TTerm (Any -> Any) -> Field
forall a. String -> TTerm a -> Field
>:
          Type -> Type -> TTerm (Any -> Any) -> TTerm (Any -> Any)
forall a. Type -> Type -> TTerm a -> TTerm a
function (Type -> Type -> Type
pairT Type
stringT Type
termT) Type
stringT (TTerm (Any -> Any) -> TTerm (Any -> Any))
-> TTerm (Any -> Any) -> TTerm (Any -> Any)
forall a b. (a -> b) -> a -> b
$
          String -> TTerm String -> TTerm (Any -> Any)
forall x a b. String -> TTerm x -> TTerm (a -> b)
lambda String
"pair" (TTerm String -> TTerm (Any -> Any))
-> TTerm String -> TTerm (Any -> Any)
forall a b. (a -> b) -> a -> b
$ TTerm String
"\t" TTerm String -> TTerm String -> TTerm String
++ (TTerm (Name -> String)
Core.unName TTerm (Name -> String) -> TTerm Name -> TTerm String
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ (TTerm ((Name, Any) -> Name)
forall a b. TTerm ((a, b) -> a)
first TTerm ((Name, Any) -> Name) -> TTerm (Name, Any) -> TTerm Name
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ String -> TTerm (Name, Any)
forall a. String -> TTerm a
var String
"pair")) TTerm String -> TTerm String -> TTerm String
++ TTerm String
": " TTerm String -> TTerm String -> TTerm String
++ (TTerm (Term -> String)
Io.showTerm TTerm (Term -> String) -> TTerm Term -> TTerm String
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ (TTerm ((Any, Term) -> Term)
forall a b. TTerm ((a, b) -> b)
second TTerm ((Any, Term) -> Term) -> TTerm (Any, Term) -> TTerm Term
forall a b. TTerm (a -> b) -> TTerm a -> TTerm b
@@ String -> TTerm (Any, Term)
forall a. String -> TTerm a
var String
"pair"))])