module Database.RRDtool.Expression
    ( MentionedVars(..)
    , ApplyMentionedVarsOf(..)

    , IsExpr
    , IsCommonExpr
    , IterativeExpr
    , IsAggregativeExpr

    , IsExprSet
    , IsCommonExprSet

    , IsVarName
    , IsShortEnoughForVarName
    , IsGoodLetterForVarName

    , Constant(..)
    , Variable(..)
    , IsVariableSet
    , CommonUnaryOp(..)
    , CommonBinaryOp(..)
    , CommonTrinaryOp(..)
    , CommonSetOp(..)
    , TrendOp(..)
    , VariableShiftPredictOp(..)
    , FixedShiftPredictOp(..)
    , CommonValue(..)
    , IterativeValue(..)
    , IterativeValueOf(..)
    , AggregativeUnaryOp(..)
    )
    where

import Data.HList
import Data.HList.String
import Types.Data.Bool
import Types.Data.Num hiding ((:*:))
import Types.Data.Ord


-- MentionedVars
class IsVariableSet (MentionedVarsOf a) => MentionedVars a where
    type MentionedVarsOf a

-- ApplyMentionedVarsOf
data ApplyMentionedVarsOf = ApplyMentionedVarsOf

instance Applyable ApplyMentionedVarsOf a where
    type Apply ApplyMentionedVarsOf a = MentionedVarsOf a
    apply = undefined

-- IsExpr
class (Show e, Eq e) => IsExpr e
class IsExpr e => IsCommonExpr e
class IsExpr e => IterativeExpr e
class IsExpr e => IsAggregativeExpr e

class (Show es, Eq es, HList es) => IsExprSet es
instance IsExprSet HNil
instance (IsExpr e, IsExprSet es) => IsExprSet (HCons e es)

class (Show es, Eq es, HList es) => IsCommonExprSet es
instance IsCommonExprSet HNil
instance (IsCommonExpr e, IsCommonExprSet es) => IsCommonExprSet (HCons e es)


-- Constants and variable names
data Constant
    = Const !Double
    deriving (Show, Eq, Ord)
instance IsExpr Constant
instance IsCommonExpr Constant
instance MentionedVars Constant where
    type MentionedVarsOf Constant = HNil

{- This is what we want to do but GHC can't handle this for now. 
class ( (HLengthOf str :<=: D255) ~ True
      , HString str
      )
    => IsVarName str
-}
class ( IsShortEnoughForVarName str
      , HString str
      )
    => IsVarName str

class HString str => IsShortEnoughForVarName str
instance ( HString str
         , (HLength str :<=: D255) ~ True
         )
    => IsShortEnoughForVarName str

class IntegerT c => GoodLetterForVarName c where
    type IsGoodLetterForVarName c

instance IntegerT c => GoodLetterForVarName c where
    type IsGoodLetterForVarName c = ( (c :>=: D65) :&&: (c :<=:  D90) ) -- A-Z
                                    :||:
                                    ( (c :>=: D99) :&&: (c :<=: D122) ) -- a-z
                                    :||:
                                    ( c :==: D45 ) -- '-'
                                    :||:
                                    ( c :==: D95 ) -- '_'

--instance (a :>=: D65) ~ True => IsGoodLetterForVarName a

-- Variable
data Variable vn
    = Variable !vn
    deriving (Show, Eq, Ord)

instance IsVarName vn => IsExpr (Variable vn)
instance IsVarName vn => IsCommonExpr (Variable vn)
instance IsVarName vn => MentionedVars (Variable vn) where
    type MentionedVarsOf (Variable vn) = vn :*: HNil

class HList vs => IsVariableSet vs
instance IsVariableSet HNil
instance (IsVarName v, IsVariableSet vs) => IsVariableSet (HCons v vs)

-- Common operators
data CommonUnaryOp a
    = IsUnknown  !a
    | IsInfinity !a
    | Sin        !a
    | Cos        !a
    | Log        !a
    | Exp        !a
    | Sqrt       !a
    | Atan       !a
    | Floor      !a
    | Ceil       !a
    | Deg2Rad    !a
    | Rad2Deg    !a
    | Abs        !a
    deriving (Show, Eq, Ord)
instance IsExpr a => IsExpr (CommonUnaryOp a)
instance IsCommonExpr a => IsCommonExpr (CommonUnaryOp a)
instance IsVariableSet (MentionedVarsOf a) => MentionedVars (CommonUnaryOp a) where
    type MentionedVarsOf (CommonUnaryOp a) = MentionedVarsOf a

data CommonBinaryOp a b
    = !a :<:  !b
    | !a :<=: !b
    | !a :>:  !b
    | !a :>=: !b
    | !a :==: !b
    | !a :/=: !b
    | Min !a !b
    | Max !a !b
    | !a :+: !b
    | !a :-: !b
    | !a :*: !b
    | !a :/: !b
    | !a :%: !b
    | AddNaN !a !b
    | AtanXY !a !b
    deriving (Show, Eq, Ord)

instance (IsExpr a, IsExpr b) =>
    IsExpr (CommonBinaryOp a b)

instance (IsCommonExpr a, IsCommonExpr b) =>
    IsCommonExpr (CommonBinaryOp a b)

instance IsVariableSet (MentionedVarsOf a :++: MentionedVarsOf b) =>
    MentionedVars (CommonBinaryOp a b) where
        type MentionedVarsOf (CommonBinaryOp a b)
            = MentionedVarsOf a :++: MentionedVarsOf b
        

data CommonTrinaryOp a b c
    = If !a !b !c
    | Limit !a !b !c
    deriving (Show, Eq, Ord)

instance (IsExpr a, IsExpr b, IsExpr c)
    => IsExpr (CommonTrinaryOp a b c)

instance (IsCommonExpr a, IsCommonExpr b, IsCommonExpr c)
    => IsCommonExpr (CommonTrinaryOp a b c)

instance IsVariableSet (MentionedVarsOf a :++:
                        MentionedVarsOf b :++:
                        MentionedVarsOf c) =>
    MentionedVars (CommonTrinaryOp a b c) where
        type MentionedVarsOf (CommonTrinaryOp a b c)
            = MentionedVarsOf a :++:
              MentionedVarsOf b :++:
              MentionedVarsOf c

-- SORT and REV can't be expressed in this way as they pushes possibly
-- multiple values onto the stack...

data CommonSetOp es
    = AverageOf !es
    deriving (Show, Eq, Ord)

instance IsExprSet es => IsExpr (CommonSetOp es)
instance (IsExprSet es, IsCommonExprSet es) => IsCommonExpr (CommonSetOp es)
instance IsVariableSet (HConcat (HMap ApplyMentionedVarsOf es)) =>
    MentionedVars (CommonSetOp es) where
        type MentionedVarsOf (CommonSetOp es)
            = HConcat (HMap ApplyMentionedVarsOf es)

data TrendOp vn a
    = Trend      !(Variable vn) !a
    | TrendNan   !(Variable vn) !a
    deriving (Show, Eq, Ord)
instance (IsVarName vn, IsExpr a) => IsExpr (TrendOp vn a)
instance (IsVarName vn, IsCommonExpr a) => IsCommonExpr (TrendOp vn a)

instance ( IsVariableSet (vn :*: MentionedVarsOf a)
         ) => MentionedVars (TrendOp vn a) where
    type MentionedVarsOf (TrendOp vn a) = vn :*: MentionedVarsOf a

data VariableShiftPredictOp ss w vn
    = VariableShiftPredictAverage !ss !w !(Variable vn)
    | VariableShiftPredictSigma   !ss !w !(Variable vn)
    deriving (Show, Eq, Ord)
instance (IsExprSet ss, IsExpr w, IsVarName vn)
    => IsExpr (VariableShiftPredictOp ss w vn)
instance (IsExprSet ss, IsCommonExprSet ss, IsCommonExpr w, IsVarName vn)
    => IsCommonExpr (VariableShiftPredictOp ss w vn)
instance ( IsVariableSet (vn :*: (MentionedVarsOf ss :++: MentionedVarsOf w))
         ) => MentionedVars (VariableShiftPredictOp ss w vn) where
    type MentionedVarsOf (VariableShiftPredictOp ss w vn)
        = vn :*: (MentionedVarsOf ss :++: MentionedVarsOf w)

-- FixedShiftPredictOp
data FixedShiftPredictOp sm w vn
    = FixedShiftPredictAverage !sm !w !(Variable vn)
    | FixedShiftPredictSigma   !sm !w !(Variable vn)
    deriving (Show, Eq, Ord)

instance (IsExpr sm, IsExpr w, IsVarName vn)
    => IsExpr (FixedShiftPredictOp sm w vn)

instance (IsCommonExpr sm, IsCommonExpr w, IsVarName vn)
    => IsCommonExpr (FixedShiftPredictOp sm w vn)

instance ( IsVariableSet (vn :*: (MentionedVarsOf sm :++: MentionedVarsOf w))
         ) => MentionedVars (FixedShiftPredictOp sm w vn) where
    type MentionedVarsOf (FixedShiftPredictOp sm w vn)
        = vn :*: (MentionedVarsOf sm :++: MentionedVarsOf w)

-- Common special values
data CommonValue
    = Unknown
    | Infinity
    | NegativeInfinity
    | Now
    deriving (Show, Eq, Ord)

instance IsExpr CommonValue

instance IsCommonExpr CommonValue

instance MentionedVars CommonValue where
    type MentionedVarsOf CommonValue = HNil

-- Iterative special values
data IterativeValue
    = Previous
    | Count
    | TakenTime
    | TakenLocalTime
    deriving (Show, Eq, Ord)

instance IsExpr IterativeValue

instance IterativeExpr IterativeValue

instance MentionedVars IterativeValue where
    type MentionedVarsOf IterativeValue = HNil

-- Iterative special values of something
data IterativeValueOf vn
    = PreviousOf !(Variable vn)
    deriving (Show, Eq, Ord)

instance IsVarName vn => IsExpr (IterativeValueOf vn)

instance IsVarName vn => IterativeExpr (IterativeValueOf vn)

instance IsVarName vn => MentionedVars (IterativeValueOf vn) where
    type MentionedVarsOf (IterativeValueOf vn) = vn :*: HNil

-- Aggregative operators (fairly restricted due to rrdtool's
-- restriction)
data AggregativeUnaryOp vn
    = Maximum    !(Variable vn)
    | Minimum    !(Variable vn)
    | Average    !(Variable vn)
    | StandardDeviation !(Variable vn)
    | First      !(Variable vn)
    | Last       !(Variable vn)
    | Total      !(Variable vn)
    | Percent    !(Variable vn) !Constant
    | PercentNan !(Variable vn) !Constant
    | LSLSlope   !(Variable vn)
    | LSLInt     !(Variable vn)
    | LSLCorrel  !(Variable vn)
    deriving (Show, Eq, Ord)

instance IsVarName vn => IsExpr (AggregativeUnaryOp vn)

instance IsVarName vn => IsAggregativeExpr (AggregativeUnaryOp vn)

instance IsVarName vn => MentionedVars (AggregativeUnaryOp vn) where
    type MentionedVarsOf (AggregativeUnaryOp vn) = vn :*: HNil