SEParser.hs

-----------------------------------------------------------------------------
-- 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.SubExpr.SEParser
  ( -- * SubExpression Parser
    SEParser, get, put, gets, modify, seParse
  -- * User state
  , SEState(..), getVarKey, addMatching
  -- * Input type
  , InputType(..), determineInputType, conformsTo, resetAfter, resetSEState
  ) where

import Control.Applicative
import Control.Monad
import Control.Monad.State
import qualified Data.Map as M
import Data.Maybe
import qualified Data.Set as S
import Domain.Math.Expr
import Domain.Math.Data.Relation
import Recognize.Data.Math
import qualified Recognize.Expr.Functions as F
import Recognize.SubExpr.Functions
import Recognize.Parsing.Parser
import Control.Monad.Identity

-- | Describes some math type
data InputType = Expr | Definition | Equation | LinearWithType RelationType | Linear deriving (Eq,Show)

-- | Given an expression, check whether it matches the specified input type.
conformsTo :: Expr -> InputType -> Bool
conformsTo e Expr = isNothing $ getEqE e
conformsTo e Definition = isJust $ do
  (x :==: _) <- getEqE e
  guard $ isFunctionCall x || F.isVar x
conformsTo e Equation = isJust $ do
  rel <- getRelationE e
  let x = leftHandSide rel
  let y = rightHandSide rel
  guard (not (F.hasVar x || F.hasVar y) && not (isFunctionCall x))
conformsTo e Linear = isJust $ do
  rel <- getRelationE e
  let x = leftHandSide rel
  let y = rightHandSide rel
  guard (not (F.isVar x) && (F.hasVar x || F.hasVar y))
--LinearWithType is a  linear expression with the given relationType.
conformsTo e (LinearWithType t) = (conformsTo e Linear) && (isJust $ do
  rel <- getRelationE e
  let sym = relationType rel
  guard (sym == t))

-- | Determine the input type of the given expression
determineInputType :: Expr -> InputType
determineInputType e
  | e `conformsTo` Definition = Definition
  | e `conformsTo` Equation = Equation
  | e `conformsTo` Linear = Linear
  | e `conformsTo` (LinearWithType EqualTo) = Linear
  | e `conformsTo` (LinearWithType LessThan) = Linear
  | otherwise = Expr

-- | The user state of the subexpression recognizer
--
-- It carries parameters for the recognizer, mapping of vars to expressions and other information
data SEState = SEState
  { optGrow          :: Bool -- Let the mother expression grow
  , growF            :: Expr -> Expr -- Grow function
  , optIterate       :: Bool -- Try more than one iteration
  , optTraverse      :: Bool -- Allow traversal of mother expression
  , optSimplify      :: Bool -- ^ Allow simplification of mother expression
  , optSkipOnce      :: Bool -- Allow expressions to be skipOnced
  , chainedEquations :: Bool -- Does the solution contain chained equations? Then maybe we want to parse differently.
  , precision        :: Int -- Number of decimals that are kept in simplification
  , matchings        :: S.Set Expr
  , usedVariables    :: M.Map String Expr -- Variables that are known to be used
  , inputType        :: Maybe [InputType] -- ^ Type of expressions that may be parsed
  , matchPredicate   :: Expr -> Bool
  }

-- | Default user state
emptyState :: SEState
emptyState = SEState
  { optGrow          = False
  , growF            = id
  , optIterate       = True
  , optTraverse      = True
  , optSimplify      = True
  , optSkipOnce      = False
  , chainedEquations = False
  , precision        = 2
  , matchings        = S.empty
  , usedVariables    = M.empty
  , inputType        = Nothing
  , matchPredicate   = const True
  }

type SEParser = ParserT SEState Math Identity

seParse :: SEParser a -> [Math] -> Maybe a
seParse p ss =
   case runIdentity (runParserT p emptyState ss) of
      [] -> Nothing
      (a, _, _):_ -> Just a

getVarKey :: Expr -> SEParser String
getVarKey (Sym s [Var x]) = guard (isVarSymbol s) >> return x
getVarKey _ = empty

addMatching :: Expr -> SEParser ()
addMatching e =
   modify $ \st -> st { matchings = S.insert e (matchings st) }

-- | Reset the user state to `dSEState` after executing the parser
resetAfter :: SEParser a -> SEParser a
resetAfter sp = do
  a <- sp
  put emptyState
  return a

-- | Reset the user state to `dSEState`. Returns the user state before resetting.
resetSEState :: SEParser SEState
resetSEState = do
  us <- get
  put emptyState
  return us