diff --git a/Graphics/Implicit/ExtOpenScad/Eval/Module.hs b/Graphics/Implicit/ExtOpenScad/Eval/Module.hs index c2b669b2..cc5d8f8c 100644 --- a/Graphics/Implicit/ExtOpenScad/Eval/Module.hs +++ b/Graphics/Implicit/ExtOpenScad/Eval/Module.hs @@ -14,10 +14,10 @@ module Graphics.Implicit.ExtOpenScad.Eval.Module ( runModule, ) where -import Prelude(Maybe(Just, Nothing), Bool(False), (>), (.), ($), elem, error, filter, fmap, fst, init, last, length, not, notElem, null, show, snd, pure, zip, (<>), (&&), (==), (/=), String, (<$>)) +import Prelude(Maybe(Just, Nothing), Bool(False), (.), ($), elem, error, filter, fmap, fst, init, last, length, not, notElem, null, show, snd, pure, zip, (<>), (&&), (==), (/=), String, (<$>)) import Graphics.Implicit.ExtOpenScad.Definitions ( - Expr(LitE), + Expr(), OVal(OUModule, ONModule, ONModuleWithSuite, OVargsModule), SourcePosition, StateC, @@ -25,7 +25,7 @@ import Graphics.Implicit.ExtOpenScad.Definitions ( Symbol(Symbol) ) -import Graphics.Implicit.ExtOpenScad.Util.StateC (errorC, warnC) +import Graphics.Implicit.ExtOpenScad.Util.StateC (errorC) import qualified Data.List as DL (intercalate) @@ -111,6 +111,8 @@ checkInstances :: SourcePosition -> OVal -> [(Maybe Symbol, Expr)] -> [[(Symbol, checkInstances sourcePos mod argsExpr forms = do possibleInstances <- selectInstances forms argsExpr sourcePos when (null possibleInstances) (errorC sourcePos $ "No instance of " <> nameOfModule mod <> " found to match given parameters.\narguments given:\n" <> pack (show argsExpr) <> "\nForms available:" <> pack (show forms) <> "\n") +-- FIXME: make this a warning that can be turned on and off, and is off by default. +{- when (length possibleInstances > 1) (warnC sourcePos $ "Multiple instances of " <> nameOfModule mod <> " found matching given parameters.\nInstances found:\n" <> (DTL.concat $ showInstance mod <$> possibleInstances) <> "Parameters given: " <> nameOfModule mod <> "(" <> (DTL.intercalate ", " $ showParameter <$> argsExpr) <> ");") where showParameter :: (Maybe Symbol, Expr) -> Text @@ -121,6 +123,7 @@ checkInstances sourcePos mod argsExpr forms = do showInstance myMod args = nameOfModule myMod <> "(" <> (DTL.intercalate "," $ showArg <$> args) <> ");\n" showArg :: (Symbol, Bool) -> Text showArg (Symbol argName, optional) = argName <> "=...(" <> (if optional then "optional)" else "required)") +-} -- Run a module. runModule :: SourcePosition -> (Maybe (StateC [OVal]), [String]) -> StateC [OVal] diff --git a/Graphics/Implicit/ExtOpenScad/Primitives.hs b/Graphics/Implicit/ExtOpenScad/Primitives.hs index 6ec3eceb..de866c01 100644 --- a/Graphics/Implicit/ExtOpenScad/Primitives.hs +++ b/Graphics/Implicit/ExtOpenScad/Primitives.hs @@ -64,12 +64,14 @@ import Linear.Affine (qdA) import System.Directory (doesFileExist) +import Type.Reflection (Typeable) + default (ℝ) -- FIXME: `defaultTo` is used inconsistently. The line between defaults and examples is a bit blurry. -- | Use the old syntax when defining arguments. -argument :: OTypeMirror desiredType => Text -> ArgParser desiredType +argument :: (OTypeMirror desiredType, Typeable desiredType) => Text -> ArgParser desiredType argument a = GIEUA.argument (Symbol a) -- | The only thing exported here. basically, a list of modules. diff --git a/Graphics/Implicit/ExtOpenScad/Util/ArgParser.hs b/Graphics/Implicit/ExtOpenScad/Util/ArgParser.hs index 0882301a..e7ccd4c6 100644 --- a/Graphics/Implicit/ExtOpenScad/Util/ArgParser.hs +++ b/Graphics/Implicit/ExtOpenScad/Util/ArgParser.hs @@ -8,6 +8,9 @@ -- Allow us to use string literals for Text {-# LANGUAGE OverloadedStrings #-} +-- Allow us to display a target type. +{-# LANGUAGE TypeApplications #-} + module Graphics.Implicit.ExtOpenScad.Util.ArgParser ( argMap, argument, @@ -28,7 +31,7 @@ import qualified Prelude as P (null) import Graphics.Implicit.ExtOpenScad.Definitions (ArgParser(AP, APTest, APBranch, APTerminator, APFail, APExample), OVal (OError), TestInvariant(EulerCharacteristic, ContoursAreClosed, MeshIsWaterTight), Symbol, VarLookup(VarLookup)) -import Graphics.Implicit.ExtOpenScad.Util.OVal (fromOObj, toOObj, OTypeMirror) +import Graphics.Implicit.ExtOpenScad.Util.OVal (fromOObj, oTypeStr, toOObj, OTypeMirror) import Graphics.Implicit.Definitions(ℕ, ℝ) @@ -40,6 +43,8 @@ import Data.Maybe (isNothing, fromJust, isJust) import Data.Text.Lazy (Text, pack, unpack) +import Type.Reflection (Typeable, typeRep) + import Control.Arrow (first) -- * ArgParser building functions @@ -48,7 +53,7 @@ import Control.Arrow (first) -- | Builds an argparser for the type that is expected from it. -- FIXME: make a version of this that accepts multiple symbol names, so we can have h= and height= -argument :: forall desiredType. (OTypeMirror desiredType) => Symbol -> ArgParser desiredType +argument :: forall desiredType. (OTypeMirror desiredType, Typeable desiredType) => Symbol -> ArgParser desiredType argument name = AP name Nothing "" $ \oObjVal -> do let @@ -58,7 +63,9 @@ argument name = errmsg = case oObjVal of OError err -> "error in computing value for argument " <> pack (show name) <> ": " <> err - _ -> "arg " <> pack (show oObjVal) <> " not compatible with " <> pack (show name) + _ -> "arg " <> pack (show name) <> + " expected " <> pack (show $ typeRep @desiredType) <> + " but found " <> oTypeStr oObjVal maybe (APFail errmsg) APTerminator val {-# INLINABLE argument #-}