{-  Copyright 2010 Dominique Devriese

    This file is part of the grammar-combinators library.

    The grammar-combinators library is free software: you can
    redistribute it and/or modify it under the terms of the GNU
    Lesser General Public License as published by the Free
    Software Foundation, either version 3 of the License, or (at
    your option) any later version.

    Foobar is distributed in the hope that it will be useful, but
    WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
    GNU Lesser General Public License for more details.

    You should have received a copy of the GNU Lesser General
    Public License along with Foobar. If not, see
    <http://www.gnu.org/licenses/>.
-}
{-# LANGUAGE TypeFamilies #-}

module Text.GrammarCombinators.Test.Evaluator where

import Text.GrammarCombinators.Base

import Generics.MultiRec.FoldAlg

import Text.GrammarCombinators.Test.Grammar

data family NodeValue ix
data instance NodeValue AdditiveExpr = NVA Int deriving (Show, Eq)
data instance NodeValue MultiplicativeExpr = NVM Int deriving (Show, Eq)
data instance NodeValue PrimaryExpr = NVP Int deriving (Show, Eq)
data instance NodeValue Decimal = NVD Int deriving (Show, Eq)


calcAlg :: Algebra ASTNode NodeValue
calcAlg = const ( (\(NVM a) (NVA b) -> NVA (a+b))
                & (\(NVM a) -> NVA a)
                & (\(NVP a) (NVM b) -> NVM (a*b))
                & (\(NVP a) -> NVM a)
                & (\(NVA a) -> NVP a)
                & (\(NVD a) -> NVP a)
                & (\c -> NVD $ read (c:"")))


-- calculateHandler :: Algebra ASTNode NodeValue 
-- calculateHandler AdditiveExprProof (L (Tag (I (I0 tl) :*: I (I0 tr)))) = tl + tr
-- calculateHandler AdditiveExprProof (R (L (Tag (I (I0 t))))) = tl 
-- calculateHandler MultiplicativeExprProof (R (R (L (Tag (I (I0 fl) :*: I (I0 fr)))))) = fl * fr
-- calculateHandler MultiplicativeExprProof (R (R (R (L (Tag (I (I0 f))))))) = f
-- calculateHandler PrimaryExprProof (R (R (R (R (L (Tag (I (I0 t)))) = t
-- calculateHandler PrimaryExprProof (R (R (R (R (R (L (Tag (I (I0 d))))))))) = d 
-- calculateHandler DecimalProof (R (R (R (R (R (R (L (Tag (I (I0 c)))))))))) = read (c:"")
-- calculateHandler CharacterProof (R (R (R (R (R (R (R (L (Tag (K c)))))))))) = c

evaluator :: Processor ASTNode NodeValue
evaluator = alg . calcAlg