{-# LANGUAGE
  EmptyDataDecls,
  FlexibleInstances,
  TypeFamilies,
  TypeOperators,
  MultiParamTypeClasses,
  UndecidableInstances
  #-}
module Database.RRDtool.Expression
    ( MentionedVars
    , MentionedVarsA(..)

    , IsExpr
    , IsCommonExpr
    , IsIterativeExpr

    , IsVarName
    , hString

    , Constant(..)
    , Variable(..)
    , 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
type family MentionedVars a

-- MentionedVarsA
data MentionedVarsA = MentionedVarsA

instance ApplyT MentionedVarsA a where
    type Apply MentionedVarsA a = MentionedVars a

-- IsExpr
--class (Show e, Eq e) => IsExpr e
type family IsExpr e
type family IsCommonExpr e
type family IsIterativeExpr e

type family   IsExprSet es
type instance IsExprSet Nil         = True
type instance IsExprSet (Cons e es) = IsExpr e :&&: IsExprSet es

type family   IsCommonExprSet es
type instance IsCommonExprSet Nil         = True
type instance IsCommonExprSet (Cons e es) = IsCommonExpr e :&&: IsCommonExprSet es

type family   IsIterativeExprSet es
type instance IsIterativeExprSet Nil         = True
type instance IsIterativeExprSet (Cons e es) = IsIterativeExpr e :&&: IsIterativeExprSet es

-- Constants and variable names
data Constant
    = Const !Double
    deriving (Show, Eq, Ord)

type instance IsExpr          Constant = True
type instance IsCommonExpr    Constant = True
type instance IsIterativeExpr Constant = True
type instance MentionedVars   Constant = Nil

{- This is what we want to do but GHC can't handle this for now. 
class ( (Length str :<=: D19) ~ True
      , HString str
      )
    => IsVarName str
-}
type family   IsVarName str
type instance IsVarName str = ( (Length str :>: D0)
                                :&&:
                                (Length str :<=: D19)
                                :&&:
                                (All IsGoodLetterForVarNameA str)
                              )

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

data IsGoodLetterForVarNameA
instance ApplyT IsGoodLetterForVarNameA c where
    type Apply IsGoodLetterForVarNameA c = IsGoodLetterForVarName c

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

type instance IsExpr          (Variable vn) = True
type instance IsCommonExpr    (Variable vn) = True
type instance IsIterativeExpr (Variable vn) = True
type instance MentionedVars   (Variable vn) = vn :&: Nil

type family   IsVariableSet vs
type instance IsVariableSet Nil         = True
type instance IsVariableSet (Cons v vs) = IsVarName v :&&: IsVariableSet 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)

type instance IsExpr          (CommonUnaryOp a) = IsExpr a
type instance IsCommonExpr    (CommonUnaryOp a) = IsCommonExpr a
type instance IsIterativeExpr (CommonUnaryOp a) = IsIterativeExpr a
type instance MentionedVars   (CommonUnaryOp a) = MentionedVars 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)

type instance IsExpr (CommonBinaryOp a b)
    = IsExpr a :&&: IsExpr b

type instance IsCommonExpr (CommonBinaryOp a b)
    = IsCommonExpr a :&&: IsCommonExpr b

type instance IsIterativeExpr (CommonBinaryOp a b)
    = IsIterativeExpr a :&&: IsIterativeExpr b

type instance MentionedVars (CommonBinaryOp a b)
    = MentionedVars a :++: MentionedVars b
        

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

type instance IsExpr (CommonTrinaryOp a b c)
    = IsExpr a :&&: IsExpr b :&&: IsExpr c

type instance IsCommonExpr (CommonTrinaryOp a b c)
    = IsCommonExpr a :&&: IsCommonExpr b :&&: IsCommonExpr c

type instance IsIterativeExpr (CommonTrinaryOp a b c)
    = IsIterativeExpr a :&&:
      IsIterativeExpr b :&&:
      IsIterativeExpr c

type instance MentionedVars (CommonTrinaryOp a b c)
    = MentionedVars a :++: MentionedVars b :++: MentionedVars c

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

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

type instance IsExpr          (CommonSetOp es) = IsExprSet          es
type instance IsCommonExpr    (CommonSetOp es) = IsCommonExprSet    es
type instance IsIterativeExpr (CommonSetOp es) = IsIterativeExprSet es
type instance MentionedVars   (CommonSetOp es) = Concat (Map MentionedVarsA es)

-- TrendOp
data TrendOp vn e
    = Trend      !(Variable vn) !e
    | TrendNan   !(Variable vn) !e
    deriving (Show, Eq, Ord)

type instance IsExpr          (TrendOp vn e) = IsVarName vn :&&: IsExpr e
type instance IsCommonExpr    (TrendOp vn e) = IsVarName vn :&&: IsCommonExpr e
type instance IsIterativeExpr (TrendOp vn e) = IsVarName vn :&&: IsIterativeExpr e
type instance MentionedVars   (TrendOp vn e) = vn :&: MentionedVars e

-- VariableShiftPredictOp
data VariableShiftPredictOp ss w vn
    = VariableShiftPredictAverage !ss !w !(Variable vn)
    | VariableShiftPredictSigma   !ss !w !(Variable vn)
    deriving (Show, Eq, Ord)

type instance IsExpr (VariableShiftPredictOp ss w vn)
    = IsExprSet ss :&&: IsExpr w :&&: IsVarName vn

type instance IsCommonExpr (VariableShiftPredictOp ss w vn)
    = IsCommonExprSet ss :&&: IsCommonExpr w :&&: IsVarName vn

type instance IsIterativeExpr (VariableShiftPredictOp ss w vn)
    = IsIterativeExprSet ss :&&: IsIterativeExpr w :&&: IsVarName vn

type instance MentionedVars (VariableShiftPredictOp ss w vn)
    = vn :&: (MentionedVars ss :++: MentionedVars w)

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

type instance IsExpr (FixedShiftPredictOp sm w vn)
    = IsExpr sm :&&: IsExpr w :&&: IsVarName vn

type instance IsCommonExpr (FixedShiftPredictOp sm w vn)
    = IsCommonExpr sm :&&: IsCommonExpr w :&&: IsVarName vn

type instance IsIterativeExpr (FixedShiftPredictOp sm w vn)
    = IsIterativeExpr sm :&&: IsIterativeExpr w :&&: IsVarName vn

type instance MentionedVars (FixedShiftPredictOp sm w vn)
    = vn :&: (MentionedVars sm :++: MentionedVars w)

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

type instance IsExpr          CommonValue = True
type instance IsCommonExpr    CommonValue = True
type instance IsIterativeExpr CommonValue = True
type instance MentionedVars   CommonValue = Nil

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

type instance IsExpr          IterativeValue = True
type instance IsCommonExpr    IterativeValue = False
type instance IsIterativeExpr IterativeValue = True
type instance MentionedVars   IterativeValue = Nil

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

type instance IsExpr          (IterativeValueOf vn) = IsVarName vn
type instance IsCommonExpr    (IterativeValueOf vn) = False
type instance IsIterativeExpr (IterativeValueOf vn) = IsVarName vn
type instance MentionedVars   (IterativeValueOf vn) = vn :&: Nil

-- 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)

type instance MentionedVars (AggregativeUnaryOp vn) = vn :&: Nil