{- |
Description: Module for colouring features and feature formulas.
License: GNU LGPLv3
Maintainer: paul.bittner@uni-ulm.de

Module for colouring features and feature formulas.
We use this colouring for visualizing features when printing to terminal.
-}
module FeatureColour (
    ColourPalette,
    FeatureColourPalette,
    FeatureFormulaColourPalette,
    defaultFeatureFormulaColouring
) where

import Feature
import Propositions
import System.Terminal

-- | A 'ColourPalette' assigns values of type @a@ to 'Color's.
type ColourPalette a m = a -> Color m
-- | A 'FeatureColourPalette' is a 'ColourPalette' for 'Feature's.
type FeatureColourPalette m = ColourPalette Feature m
-- | A 'FeatureFormulaColourPalette' is a 'ColourPalette' for 'FeatureFormula's.
type FeatureFormulaColourPalette m = ColourPalette FeatureFormula m

-- | The default colour to use when no other colour is specified.
defaultColour :: (MonadColorPrinter m) => Color m
defaultColour :: Color m
defaultColour = Color m
forall (m :: * -> *). MonadColorPrinter m => Color m
white

-- | Inverts the given colour.
-- Currently implemented as @id@ as inverting terminal colours is not possible right away.
negate :: (MonadColorPrinter m) => Color m -> Color m
negate :: Color m -> Color m
negate = Color m -> Color m
forall a. a -> a
id

-- | Mixes two colours.
-- As ANSI colours cannot be mixed in a generic way, always returns @bright magenta@.
mix :: (MonadColorPrinter m) => Color m -> Color m -> Color m
mix :: Color m -> Color m -> Color m
mix _ _ = Color m -> Color m
forall (m :: * -> *). MonadColorPrinter m => Color m -> Color m
bright Color m
forall (m :: * -> *). MonadColorPrinter m => Color m
magenta -- We cannot mix those ANSI colours so just use magenta to indicate a mixture

-- | Lifts a colour palette over features ('FeatureColourPalette') to a palette over formulas ('FeatureFormulaColourPalette').
defaultFeatureFormulaColouring :: (MonadColorPrinter m) => FeatureColourPalette m -> FeatureFormulaColourPalette m
defaultFeatureFormulaColouring :: FeatureColourPalette m -> FeatureFormulaColourPalette m
defaultFeatureFormulaColouring _ Nothing = Color m
forall (m :: * -> *). MonadColorPrinter m => Color m
defaultColour
defaultFeatureFormulaColouring palette :: FeatureColourPalette m
palette (Just p :: PropositionalFormula Feature
p) = FeatureColourPalette m -> PropositionalFormula Feature -> Color m
forall (m :: * -> *).
MonadColorPrinter m =>
FeatureColourPalette m -> PropositionalFormula Feature -> Color m
defaultNonNullFeatureFormulaColouring FeatureColourPalette m
palette PropositionalFormula Feature
p

-- | Given a colour palette over features ('FeatureColourPalette'), returns the colour a propositional formula over these features should have.
defaultNonNullFeatureFormulaColouring :: (MonadColorPrinter m) => FeatureColourPalette m -> NonNullFeatureFormula -> Color m
defaultNonNullFeatureFormulaColouring :: FeatureColourPalette m -> PropositionalFormula Feature -> Color m
defaultNonNullFeatureFormulaColouring palette :: FeatureColourPalette m
palette (PVariable f :: Feature
f) = FeatureColourPalette m
palette Feature
f
defaultNonNullFeatureFormulaColouring palette :: FeatureColourPalette m
palette (PNot p :: PropositionalFormula Feature
p) = Color m -> Color m
forall (m :: * -> *). MonadColorPrinter m => Color m -> Color m
FeatureColour.negate (Color m -> Color m) -> Color m -> Color m
forall a b. (a -> b) -> a -> b
$ FeatureColourPalette m -> PropositionalFormula Feature -> Color m
forall (m :: * -> *).
MonadColorPrinter m =>
FeatureColourPalette m -> PropositionalFormula Feature -> Color m
defaultNonNullFeatureFormulaColouring FeatureColourPalette m
palette PropositionalFormula Feature
p
defaultNonNullFeatureFormulaColouring _ (PAnd []) = Color m
forall (m :: * -> *). MonadColorPrinter m => Color m
defaultColour
defaultNonNullFeatureFormulaColouring _ (POr  []) = Color m
forall (m :: * -> *). MonadColorPrinter m => Color m
defaultColour
defaultNonNullFeatureFormulaColouring palette :: FeatureColourPalette m
palette (PAnd cs :: [PropositionalFormula Feature]
cs) = (Color m -> Color m -> Color m) -> [Color m] -> Color m
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Color m -> Color m -> Color m
forall (m :: * -> *).
MonadColorPrinter m =>
Color m -> Color m -> Color m
mix ([Color m] -> Color m) -> [Color m] -> Color m
forall a b. (a -> b) -> a -> b
$ FeatureColourPalette m -> PropositionalFormula Feature -> Color m
forall (m :: * -> *).
MonadColorPrinter m =>
FeatureColourPalette m -> PropositionalFormula Feature -> Color m
defaultNonNullFeatureFormulaColouring FeatureColourPalette m
palette (PropositionalFormula Feature -> Color m)
-> [PropositionalFormula Feature] -> [Color m]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PropositionalFormula Feature]
cs
defaultNonNullFeatureFormulaColouring palette :: FeatureColourPalette m
palette (POr  cs :: [PropositionalFormula Feature]
cs) = (Color m -> Color m -> Color m) -> [Color m] -> Color m
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Color m -> Color m -> Color m
forall (m :: * -> *).
MonadColorPrinter m =>
Color m -> Color m -> Color m
mix ([Color m] -> Color m) -> [Color m] -> Color m
forall a b. (a -> b) -> a -> b
$ FeatureColourPalette m -> PropositionalFormula Feature -> Color m
forall (m :: * -> *).
MonadColorPrinter m =>
FeatureColourPalette m -> PropositionalFormula Feature -> Color m
defaultNonNullFeatureFormulaColouring FeatureColourPalette m
palette (PropositionalFormula Feature -> Color m)
-> [PropositionalFormula Feature] -> [Color m]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PropositionalFormula Feature]
cs
defaultNonNullFeatureFormulaColouring _ _ = Color m
forall (m :: * -> *). MonadColorPrinter m => Color m
defaultColour