-----------------------------------------------------------------------------
-- 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)
--
-- Here we perform some natural language processing by replacing certain words with their math equivalent.
--
-----------------------------------------------------------------------------

module Recognize.Preprocessing where

import Recognize.Data.Solution
import Util.String
import qualified Data.Map as M

mapGerman :: M.Map String String
mapGerman = M.fromList {- fmap (bimap (enclose ' ') (enclose ' '))-}
 [(" mal ","*")
 ,(" durch ","/")
 ,(" plus ","+")
 ,(" hoch ","^")
 ,(" quadrat ","^2")
 ]

preProcess :: Maybe Language -> String -> String
preProcess (Just DE) = applyMap mapGerman
preProcess _ = id

applyMap :: M.Map String String -> String -> String
applyMap m s = foldr (uncurry replace) s (M.toList m)


enclose :: Char -> String -> String
enclose c s = c : s ++ [c]