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