-----------------------------------------------------------------------------
-- Copyright 2019, Advise-Me project team. This file is distributed under 
-- the terms of the Apache License 2.0. For more information, see the files
-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
-----------------------------------------------------------------------------
-- |
-- Maintainer  :  bastiaan.heeren@ou.nl
-- Stability   :  provisional
-- Portability :  portable (depends on ghc)
--
-----------------------------------------------------------------------------

module Recognize.Data.MathParserOptions
   ( MathParserOptions, mathParserOptions
   , multByConcatenation, convertToLowercase, functionCallWhitelist
   ) where

import Data.Semigroup

-- | Parameters for "Recognize.Parsing.MathParser"
data MathParserOptions = Opts
   { multByConcatenation   :: Bool -- ^ interpret ab as a*b
   , convertToLowercase    :: Bool -- ^ interpret A5 as a5
   , functionCallWhitelist :: [Char] -- ^ By default we only recognize f,g and h for function calls.
   }

mathParserOptions :: MathParserOptions
mathParserOptions = Opts
   { multByConcatenation   = True
   , convertToLowercase    = False
   , functionCallWhitelist = []
   }

instance Semigroup MathParserOptions where
   x <> y = Opts
      { multByConcatenation   = multByConcatenation x && multByConcatenation y
      , convertToLowercase    = convertToLowercase  x || convertToLowercase y
      , functionCallWhitelist = functionCallWhitelist x ++ functionCallWhitelist y
      }

instance Monoid MathParserOptions where
   mempty  = mathParserOptions
   mappend = (<>)