Typecheck better

Graphics/Implicit/ExtOpenScad/Eval/Module.hs

@@ -14,18 +14,18 @@
   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,
                                                   StatementI,
                                                   Symbol(Symbol)
                                                  )
 
-import Graphics.Implicit.ExtOpenScad.Util.StateC (errorC, warnC)
+import Graphics.Implicit.ExtOpenScad.Util.StateC (errorC)
 
 import qualified Data.List as DL (intercalate)
 
@@ -37,7 +37,7 @@
 
 import Data.Traversable (for)
 
 import Data.Text.Lazy as DTL (concat, intercalate)
 
 import Data.Text.Lazy (pack, Text)
 
@@ -111,6 +111,8 @@
 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 @@
     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]

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.

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 #-}