module Cardano.Logging.Consistency (
    NSWarnings
  , checkTraceConfiguration
  , checkTraceConfiguration'
) where

import           Cardano.Logging.ConfigurationParser
import           Cardano.Logging.Types

import           Data.Foldable as Foldable (foldl')
import qualified Data.Map.Strict as Map
import           Data.Maybe (mapMaybe)
import qualified Data.Text as T

-- | Warnings as a list of text
type NSWarnings = [T.Text]

-- | A data structure for the lookup of namespaces as nested maps
newtype NSLookup = NSLookup (Map.Map T.Text NSLookup)
  deriving Int -> NSLookup -> ShowS
[NSLookup] -> ShowS
NSLookup -> String
(Int -> NSLookup -> ShowS)
-> (NSLookup -> String) -> ([NSLookup] -> ShowS) -> Show NSLookup
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NSLookup -> ShowS
showsPrec :: Int -> NSLookup -> ShowS
$cshow :: NSLookup -> String
show :: NSLookup -> String
$cshowList :: [NSLookup] -> ShowS
showList :: [NSLookup] -> ShowS
Show


-- | Checks if all namespaces in this configuration are legal.
--   Legal in this case means that it can be found by a hierarchcical
--   lookup in all namespaces.
--   Warns if namespaces in all namespaces are not unique,
--   Warns if namespaces in all namespaces are ending in the
--   middle of another namespace.
--   The namespaces in allNamespaces are consistent with the namespaces for the
--   severityFor, privacyFor, detailsFor, documentFor and metricsDofFor functions.
checkTraceConfiguration ::
     FilePath
  -> TraceConfig
  -> [([T.Text], [T.Text])]
  -> IO NSWarnings
checkTraceConfiguration :: String -> TraceConfig -> [([Text], [Text])] -> IO [Text]
checkTraceConfiguration String
configFileName TraceConfig
defaultTraceConfig [([Text], [Text])]
allNamespaces' = do
    TraceConfig
trConfig <- String -> TraceConfig -> IO TraceConfig
readConfigurationWithDefault String
configFileName TraceConfig
defaultTraceConfig
    [Text] -> IO [Text]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Text] -> IO [Text]) -> [Text] -> IO [Text]
forall a b. (a -> b) -> a -> b
$ TraceConfig -> [([Text], [Text])] -> [Text]
checkTraceConfiguration' TraceConfig
trConfig [([Text], [Text])]
allNamespaces'

checkTraceConfiguration' ::
     TraceConfig
  -> [([T.Text], [T.Text])]
  -> NSWarnings
checkTraceConfiguration' :: TraceConfig -> [([Text], [Text])] -> [Text]
checkTraceConfiguration' TraceConfig
trConfig [([Text], [Text])]
allNamespaces' =
    let configNS :: [[Text]]
configNS        = Map [Text] [ConfigOption] -> [[Text]]
forall k a. Map k a -> [k]
Map.keys (TraceConfig -> Map [Text] [ConfigOption]
tcOptions TraceConfig
trConfig)
        emptyInner :: [([Text], [Text])]
emptyInner      = (([Text], [Text]) -> Bool)
-> [([Text], [Text])] -> [([Text], [Text])]
forall a. (a -> Bool) -> [a] -> [a]
filter ([Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Text] -> Bool)
-> (([Text], [Text]) -> [Text]) -> ([Text], [Text]) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Text], [Text]) -> [Text]
forall a b. (a, b) -> b
snd) [([Text], [Text])]
allNamespaces'
        allNamespaces'' :: [[Text]]
allNamespaces'' = (([Text], [Text]) -> [Text]) -> [([Text], [Text])] -> [[Text]]
forall a b. (a -> b) -> [a] -> [b]
map (([Text] -> [Text] -> [Text]) -> ([Text], [Text]) -> [Text]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
(<>)) [([Text], [Text])]
allNamespaces'
        (NSLookup
nsLookup, [Text]
systemWarnings) = [[Text]] -> (NSLookup, [Text])
asNSLookup [[Text]]
allNamespaces''
        configWarnings :: [Text]
configWarnings  = ([Text] -> Maybe Text) -> [[Text]] -> [Text]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (NSLookup -> [Text] -> Maybe Text
checkNamespace NSLookup
nsLookup) [[Text]]
configNS
        allWarnings :: [Text]
allWarnings     = (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text
"System namespace error: "Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) [Text]
systemWarnings
                            [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ (([Text], [Text]) -> Text) -> [([Text], [Text])] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (\([Text]
ns, [Text]
_) -> Text
"Empty inner namespace: "
                                              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
"." [Text]
ns) [([Text], [Text])]
emptyInner
                              [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text
"Config namespace error: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) [Text]
configWarnings
    in [Text]
allWarnings

-- | Check if a single namespace is legal. Legal in this case means that
--   it can be found by a hierarchcical lookup in all namespaces
checkNamespace :: NSLookup -> [T.Text] -> Maybe T.Text
checkNamespace :: NSLookup -> [Text] -> Maybe Text
checkNamespace NSLookup
nsLookup [Text]
ns = NSLookup -> [Text] -> Maybe Text
go NSLookup
nsLookup [Text]
ns
  where
    go :: NSLookup -> [T.Text] -> Maybe T.Text
    go :: NSLookup -> [Text] -> Maybe Text
go NSLookup
_ [] = Maybe Text
forall a. Maybe a
Nothing
    go (NSLookup Map Text NSLookup
l) (Text
nshd : [Text]
nstl) = case Text -> Map Text NSLookup -> Maybe NSLookup
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
nshd Map Text NSLookup
l of
                                      Maybe NSLookup
Nothing -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text
"Illegal namespace "
                                                        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
"." [Text]
ns)
                                      Just NSLookup
l2 -> NSLookup -> [Text] -> Maybe Text
go NSLookup
l2 [Text]
nstl

-- | Warns if namespaces in all namespaces are not unique,
--   Warns as well if namespaces in all namespaces are ending in the
--   middle of another namespace.
asNSLookup :: [[T.Text]] -> (NSLookup, NSWarnings)
asNSLookup :: [[Text]] -> (NSLookup, [Text])
asNSLookup = ((NSLookup, [Text]) -> [Text] -> (NSLookup, [Text]))
-> (NSLookup, [Text]) -> [[Text]] -> (NSLookup, [Text])
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Foldable.foldl' ([Text] -> (NSLookup, [Text]) -> [Text] -> (NSLookup, [Text])
fillLookup []) (Map Text NSLookup -> NSLookup
NSLookup Map Text NSLookup
forall k a. Map k a
Map.empty, [])
  where
    fillLookup :: [T.Text] -> (NSLookup, NSWarnings) -> [T.Text] -> (NSLookup, NSWarnings)
    fillLookup :: [Text] -> (NSLookup, [Text]) -> [Text] -> (NSLookup, [Text])
fillLookup [Text]
_nsFull (NSLookup Map Text NSLookup
nsl, [Text]
nsw)  [] = (Map Text NSLookup -> NSLookup
NSLookup Map Text NSLookup
nsl, [Text]
nsw)
    fillLookup [Text]
nsFull (NSLookup Map Text NSLookup
nsl, [Text]
nsw) (Text
ns1 : [Text]
nstail) =
      case Text -> Map Text NSLookup -> Maybe NSLookup
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
ns1 Map Text NSLookup
nsl of
        Maybe NSLookup
Nothing   ->  let nsNew :: Map k a
nsNew = Map k a
forall k a. Map k a
Map.empty
                          (NSLookup Map Text NSLookup
nsl2, [Text]
nsw2) = [Text] -> (NSLookup, [Text]) -> [Text] -> (NSLookup, [Text])
fillLookup
                                                    ([Text]
nsFull [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text
ns1])
                                                    (Map Text NSLookup -> NSLookup
NSLookup Map Text NSLookup
forall k a. Map k a
nsNew, [])
                                                    [Text]
nstail
                          res :: NSLookup
res = Map Text NSLookup -> NSLookup
NSLookup (Text -> NSLookup -> Map Text NSLookup -> Map Text NSLookup
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
ns1 (Map Text NSLookup -> NSLookup
NSLookup Map Text NSLookup
nsl2) Map Text NSLookup
nsl)
                          newWarnings :: [Text]
newWarnings =  [Text]
nsw [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
nsw2
                      in (NSLookup
res, [Text]
newWarnings)
        Just (NSLookup Map Text NSLookup
nsm)
                  ->  let (NSLookup Map Text NSLookup
nsl2, [Text]
nsw2) = [Text] -> (NSLookup, [Text]) -> [Text] -> (NSLookup, [Text])
fillLookup
                                                  ([Text]
nsFull [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text
ns1])
                                                  (Map Text NSLookup -> NSLookup
NSLookup Map Text NSLookup
nsm, [])
                                                  [Text]
nstail
                          res :: NSLookup
res = Map Text NSLookup -> NSLookup
NSLookup (Text -> NSLookup -> Map Text NSLookup -> Map Text NSLookup
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
ns1 (Map Text NSLookup -> NSLookup
NSLookup Map Text NSLookup
nsl2) Map Text NSLookup
nsl)
                          condWarning :: Maybe Text
condWarning = if [Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
nstail
                                          then
                                            if Map Text NSLookup -> Bool
forall k a. Map k a -> Bool
Map.null Map Text NSLookup
nsm
                                              then Text -> Maybe Text
forall a. a -> Maybe a
Just (Text
"Duplicate namespace "
                                                        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
"." ([Text]
nsFull [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text
ns1]))
                                              else Text -> Maybe Text
forall a. a -> Maybe a
Just (Text
"Inner namespace duplicate "
                                                        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
"." ([Text]
nsFull [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text
ns1]))
                                          else Maybe Text
forall a. Maybe a
Nothing
                          newWarnings :: [Text]
newWarnings = case Maybe Text
condWarning of
                                           Maybe Text
Nothing -> [Text]
nsw [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
nsw2
                                           Just Text
w  -> Text
w Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: ([Text]
nsw [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
nsw2)
                      in (NSLookup
res, [Text]
newWarnings)