Numeric.hs

{-  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 EmptyDataDecls #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeFamilies #-}

module Text.GrammarCombinators.Library.Numeric ( 
  DecimalInteger,
  NumericDomain (DecimalInteger),
  NumericValue (NVI),
  numericGrammar,
  procNumericGrammar
  ) where

import Text.GrammarCombinators.Base

data DecimalDigit
data DecimalNonZeroDigit
data DecimalInteger

-- | This domain is intended to be reused in grammars where decimal integers are used.
--   You can refer to the DecimalInteger non-terminal using the 'lib' primitive from the 'ProductionRuleWithLibrary' type class  
--   and then obtain the combined grammar by combining your grammar with 'procNumericGrammar' using the 
--   'Text.GrammarCombinators.Transform.CombineGrammars.combineGrammars' function
data NumericDomain ix where
  DecimalDigit :: NumericDomain DecimalDigit
  DecimalNonZeroDigit :: NumericDomain DecimalNonZeroDigit
  DecimalInteger :: NumericDomain DecimalInteger

instance ShowFam NumericDomain where
  showIdx DecimalDigit = "DecimalDigit"
  showIdx DecimalNonZeroDigit = "DecimalNonZeroDigit"
  showIdx DecimalInteger = "DecimalInteger"

instance FoldFam NumericDomain where
  foldFam f n = f DecimalDigit $ f DecimalNonZeroDigit $ f DecimalInteger n

instance MemoFam NumericDomain where
  data Memo NumericDomain v = MND (v DecimalDigit) (v DecimalNonZeroDigit) (v DecimalInteger)
  toMemo f = MND (f DecimalDigit) (f DecimalNonZeroDigit) (f DecimalInteger)
  fromMemo (MND v _ _) DecimalDigit = v
  fromMemo (MND _ v _) DecimalNonZeroDigit = v
  fromMemo (MND _ _ v) DecimalInteger = v

instance EqFam NumericDomain where
  overrideIdx _ DecimalDigit v DecimalDigit = v
  overrideIdx _ DecimalNonZeroDigit v DecimalNonZeroDigit = v
  overrideIdx _ DecimalInteger v DecimalInteger = v
  overrideIdx f _ _ idx = f idx

instance Domain NumericDomain

data PFNum r ix where
  DecimalDigitF :: Char -> PFNum r DecimalDigit
  DecimalNonZeroDigitF :: Char -> PFNum r DecimalNonZeroDigit
  DecimalIntegerF :: r DecimalNonZeroDigit -> [r DecimalDigit] -> PFNum r DecimalInteger

type instance PF NumericDomain = PFNum

numericGrammar :: ExtendedContextFreeGrammar NumericDomain Char
numericGrammar DecimalInteger       = DecimalIntegerF       $>> ref DecimalNonZeroDigit >>> manyRef DecimalDigit
numericGrammar DecimalDigit         = DecimalDigitF         $>> tokenRange ['0'..'9']
numericGrammar DecimalNonZeroDigit  = DecimalNonZeroDigitF  $>> tokenRange ['1'..'9']

data family NumericValue n ix
data instance NumericValue n DecimalInteger = NVI n
data instance NumericValue n DecimalDigit = NVD { unNVD :: Char }
data instance NumericValue n DecimalNonZeroDigit = NVND Char

processNumerics :: (Read n) => Processor NumericDomain (NumericValue n)
processNumerics DecimalDigit (DecimalDigitF c) = NVD c 
processNumerics DecimalNonZeroDigit (DecimalNonZeroDigitF c) = NVND c 
processNumerics DecimalInteger (DecimalIntegerF (NVND c) wcs) = NVI num
  where num = read $ c : cs
        cs = map unNVD wcs

-- | The standard processing grammar for domain 'NumericDomain', intended to be combined with other grammars using
--   the 'Text.GrammarCombinators.Transform.CombineGrammars.combineGrammars' function.
procNumericGrammar :: (Read n) => ProcessingExtendedContextFreeGrammar NumericDomain Char (NumericValue n)
procNumericGrammar = applyProcessorE numericGrammar processNumerics