{-# LANGUAGE Rank2Types #-}
-----------------------------------------------------------------------------
-- Copyright 2016, Ideas 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 Ideas.Encoding.OpenMathSupport
   ( -- * Conversion functions to/from OpenMath
     toOpenMath, fromOpenMath, noMixedFractions
   , toOMOBJ, fromOMOBJ
   ) where

import Control.Monad
import Data.Char
import Data.List
import Ideas.Common.Library
import Ideas.Text.OpenMath.Dictionary.Arith1
import Ideas.Text.OpenMath.Dictionary.Fns1
import Ideas.Text.OpenMath.Object
import Ideas.Utils.Uniplate
import qualified Ideas.Text.OpenMath.Dictionary.List1 as OM
import qualified Ideas.Text.OpenMath.Symbol as OM

-----------------------------------------------------------------------------
-- Utility functions for conversion to/from OpenMath

toOpenMath :: Monad m => Exercise a -> a -> m OMOBJ
toOpenMath ex a = do
   v <- hasTermViewM ex
   return (toOMOBJ (build v a))

fromOpenMath :: MonadPlus m => Exercise a -> OMOBJ -> m a
fromOpenMath ex omobj = do
   v <- hasTermViewM ex
   a <- fromOMOBJ omobj
   matchM v a

toOMOBJ :: IsTerm a => a -> OMOBJ
toOMOBJ = rec . toTerm
 where
   rec term =
      case term of
         TVar s    -> OMV s
         TCon s xs
            | null xs   -> OMS (idToSymbol (getId s))
            | otherwise -> make (OMS (idToSymbol (getId s)):map rec xs)
         TMeta i   -> OMV ('$' : show i)
         TNum n    -> OMI n
         TFloat d  -> OMF d
         TList xs  -> rec (function (newSymbol OM.listSymbol) xs)

   make [OMS s, OMV x, body] | s == lambdaSymbol =
      OMBIND (OMS s) [x] body
   make xs = OMA xs

fromOMOBJ :: (MonadPlus m, IsTerm a) => OMOBJ -> m a
fromOMOBJ = (>>= fromTerm) . rec
 where
   rec omobj =
      case omobj of
         OMV x  -> case isMeta x of
                      Just n  -> return (TMeta n)
                      Nothing -> return (TVar x)
         OMS s  -> return (symbol (newSymbol (OM.dictionary s, OM.symbolName s)))
         OMI n  -> return (TNum n)
         OMF a  -> return (TFloat a)
         OMA xs -> case xs of
                      OMS s:ys | s == OM.listSymbol -> TList <$> mapM rec ys
                               | otherwise -> function (newSymbol s) <$> mapM rec ys
                      _ -> fail "Invalid OpenMath object"
         OMBIND binder xs body ->
            rec (OMA (binder:map OMV xs++[body]))

   isMeta ('$':xs) = Just (foldl' (\a b -> a*10+ord b-48) 0 xs) -- '
   isMeta _        = Nothing

noMixedFractions :: OMOBJ -> OMOBJ
noMixedFractions = transform f
 where
   f (OMA [OMS s, a, b, c]) | s == mfSymbol =
      OMA [OMS plusSymbol, a, OMA [OMS divideSymbol, b, c]]
   f a = a

idToSymbol :: Id -> OM.Symbol
idToSymbol a
   | null (qualifiers a) =
        OM.extraSymbol (unqualified a)
   | otherwise =
        OM.makeSymbol (qualification a) (unqualified a)

hasTermViewM  :: Monad m => Exercise a -> m (View Term a)
hasTermViewM = maybe (fail "No support for terms") return . hasTermView

mfSymbol :: OM.Symbol
mfSymbol = OM.makeSymbol "extra" "mixedfraction"