InjFunc.hs

module Descript.Sugar.Data.InjFunc
  ( InjFunc
  , lookupFunc
  , forceLookupFunc
  ) where

import Descript.Sugar.Data.Atom
import Data.Monoid
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Prelude hiding (subtract, compare)
import qualified Prelude (compare)

-- | A function which operates on primtives, which can be accessed in
-- Descript. Returns 'Nothing' when given the wrong type of primitives.
type InjFunc = [Prim ()] -> Maybe (Prim ())

-- | All injected functions, with their corresponding identifiers.
-- (Identifiers not in 'InjSymbol' for convenience).
allFuncs :: Map String InjFunc
allFuncs = Map.fromList
  [ ("Add", add)
  , ("Subtract", subtract)
  , ("Multiply", multiply)
  , ("Compare", compare)
  , ("Append", append)
  , ("App3", app3)
  ]

-- | Gets the injected function corresponding to the given identifer.
-- Returns `Nothing` if the function doesn't exist.
lookupFunc :: InjSymbol an -> Maybe InjFunc
lookupFunc (InjSymbol _ funcId) = allFuncs Map.!? funcId

-- | Gets the injected function corresponding to the given identifer.
-- Fails if the function doesn't exist.
forceLookupFunc :: InjSymbol an -> InjFunc
forceLookupFunc (InjSymbol _ funcId) = allFuncs Map.! funcId

add :: InjFunc
add [PrimNumber () x, PrimNumber () y] = Just $ PrimNumber () $ x + y
add _ = Nothing

subtract :: InjFunc
subtract [PrimNumber () x, PrimNumber () y] = Just $ PrimNumber () $ x - y
subtract _ = Nothing

multiply :: InjFunc
multiply [PrimNumber () x, PrimNumber () y] = Just $ PrimNumber () $ x * y
multiply _ = Nothing

compare :: InjFunc
compare [PrimNumber () x, PrimNumber () y] = Just $ PrimNumber () $ x `compareNum` y
compare _ = Nothing

append :: InjFunc
append [PrimText () x, PrimText () y] = Just $ PrimText () $ x <> y
append _ = Nothing

app3 :: InjFunc
app3 [PrimText () x, PrimText () y, PrimText () z]
  = Just $ PrimText () $ x <> y <> z
app3 _ = Nothing

compareNum :: Rational -> Rational -> Rational
x `compareNum` y
  = case x `Prelude.compare` y of
         LT -> -1
         GT -> 1
         EQ -> 0