diff --git a/package.json b/package.json index ab9a21c..91b572a 100644 --- a/package.json +++ b/package.json @@ -4,7 +4,8 @@ "description": "", "main": "index.js", "scripts": { - "test": "echo \"Error: no test specified\" && exit 1" + "build": "spago build", + "test": "spago -x tests.dhall test" }, "author": "", "license": "ISC", diff --git a/spago.dhall b/spago.dhall index 1e770e4..6db54fb 100644 --- a/spago.dhall +++ b/spago.dhall @@ -4,22 +4,21 @@ You can edit this file as you like. -} { name = "typeable" , dependencies = - [ "effect" - , "psci-support" - , "either" - , "exists" - , "leibniz" - , "prelude" - , "tuples" - , "arrays" + [ "arrays" , "const" , "control" + , "either" + , "exists" , "foldable-traversable" , "identity" + , "leibniz" , "maybe" , "newtype" + , "prelude" + , "psci-support" + , "tuples" , "unsafe-coerce" ] , packages = ./packages.dhall -, sources = [ "src/**/*.purs", "test/**/*.purs" ] +, sources = [ "src/**/*.purs" ] } diff --git a/src/Data/Typeable.purs b/src/Data/Typeable.purs index 973666c..2d7d0d0 100644 --- a/src/Data/Typeable.purs +++ b/src/Data/Typeable.purs @@ -117,10 +117,10 @@ foreign import proxyTFromTagT :: forall t a. TagT t => Typeable a => ProxyT (t a instance typeableRecord :: (RL.RowToList rs ls, TypeableRecordFields ls) => Typeable (Record rs) where typeRep = typeRowToTypeRep (typeableRecordFields (RLProxy :: _ ls)) else -instance tagTFromTag1 :: (TagT t, Typeable a) => Typeable (t a) where +instance typeableTag1 :: (TagT t, Typeable a) => Typeable (t a) where typeRep = typeRepFromTag1 else -instance typeableTagT :: TagT t => Typeable t where +instance typeableTag0 :: TagT t => Typeable t where typeRep = typeRepDefault0 instance tagTFromTagT :: (TagT t, Typeable a) => TagT (t a) where diff --git a/test/Main.purs b/test/Main.purs index 3d34bf8..0297141 100644 --- a/test/Main.purs +++ b/test/Main.purs @@ -2,34 +2,62 @@ module Test.Main where import Prelude +import Control.Monad.Error.Class (class MonadThrow) import Data.Either (Either) import Data.Typeable (class TagT, TypeRep, eqTypeRep, proxyT, typeRep, typeRepFromVal) import Effect (Effect) +import Effect.Aff (launchAff_) +import Effect.Exception (Error) +import Test.Spec (describe, it) +import Test.Spec.Assertions (shouldEqual) +import Test.Spec.Reporter.Console (consoleReporter) +import Test.Spec.Runner (runSpec) foreign import clog :: forall a. a -> Effect Unit +assert :: forall m. MonadThrow Error m => Boolean -> m Unit +assert = shouldEqual true +deny :: forall m. MonadThrow Error m => Boolean -> m Unit +deny = shouldEqual false + main :: Effect Unit main = do - clog (eqTypeRep (typeRep :: _ Int) (typeRep :: _ Char)) - clog (eqTypeRep (typeRep :: _ Int) (typeRep :: _ Int)) - clog (typeRep :: _ Char) - clog (typeRep :: _ Int) + launchAff_ $ runSpec [consoleReporter] do + describe "Typeable" do + it "can handle primitives" do + deny $ eqTypeRep (typeRep :: _ Int) (typeRep :: _ Char) + it "can handle unsaturated types" do + assert $ eqTypeRep (typeRep :: _ Array) (typeRep :: _ Array) + it "can handle mixed arity" do + deny $ eqTypeRep (typeRep :: _ Array) (typeRep :: _ Person) + it "can handle user defined data types" do + assert $ eqTypeRep (typeRep :: _ Person) typePerson + assert $ eqTypeRep (typeRep :: _ Optional) (typeRep :: _ Optional) + deny $ eqTypeRep (typeRep :: _ (Optional Int)) (typeRep :: _ (Optional Char)) + it "can distinguish between distinct types with matching fields" do + deny $ eqTypeRep (typeRep :: _ Person) (typeRep :: _ Person2) + it "can handle nested types" do + assert $ eqTypeRep (typeRep :: _ (Either Int Person)) (typeRep :: _ (Either Int Person)) + assert $ eqTypeRep (typeRep :: _ (Array Person)) typeArrPerson + deny $ eqTypeRep (typeRep :: _ (Array Person2)) typeArrPerson + it "can handle bare records" do + assert $ eqTypeRep typeRecord (typeRep :: _ {name::String, age::Int}) + it "can generate type reps from values" do + assert $ eqTypeRep (typeRep :: _ (Optional Int)) (typeRepFromVal (Some 1)) + deny $ eqTypeRep (typeRep :: _ (Optional Person)) (typeRepFromVal (Some 1)) - clog (typeRep :: _ Array) - clog (typeRep :: _ {name::String, age::Int}) - clog (typeRep :: _ (Int -> Either (Either Int Int) (Optional (Array (Person))))) - clog (typeRep :: _ (Either (Either Int Int) (Optional (Array (Person))))) - clog (typeRep :: _ (Either Int Int)) - clog (typeRep :: _ (Foo Int Int Int)) - clog (eqTypeRep (typeRep :: _ Array) (typeRep :: _ Array)) - clog (eqTypeRep (typeRep :: _ Person) typePerson) - clog (eqTypeRep (typeRep :: _ (Array Person)) typeArrPerson) - clog (eqTypeRep (typeRep :: _ (Array Person2)) typeArrPerson) - clog (eqTypeRep typeRecord (typeRep :: _ {name::String, age::Int})) - clog (eqTypeRep (typeRep :: _ (Optional Int)) (typeRepFromVal (Some 1))) - clog (eqTypeRep (typeRep :: _ (Optional Person)) (typeRepFromVal (Some 1))) - clog (eqTypeRep (typeRep :: _ (Either Int Person)) (typeRep :: _ (Either Int Person))) + -- clog (eqTypeRep (typeRep :: _ Int) (typeRep :: _ Char)) + -- clog (eqTypeRep (typeRep :: _ Int) (typeRep :: _ Int)) + -- clog (typeRep :: _ Char) + -- clog (typeRep :: _ Int) + + -- clog (typeRep :: _ Array) + -- clog (typeRep :: _ {name::String, age::Int}) + -- clog (typeRep :: _ (Int -> Either (Either Int Int) (Optional (Array (Person))))) + -- clog (typeRep :: _ (Either (Either Int Int) (Optional (Array (Person))))) + -- clog (typeRep :: _ (Either Int Int)) + -- clog (typeRep :: _ (Foo Int Int Int)) where typeRecord :: TypeRep {age::Int, name::String} diff --git a/tests.dhall b/tests.dhall new file mode 100644 index 0000000..4662715 --- /dev/null +++ b/tests.dhall @@ -0,0 +1,19 @@ +{- +Welcome to a Spago project! +You can edit this file as you like. +-} +{ name = "typeable-tests" +, dependencies = + [ "aff" + , "effect" + , "either" + , "exceptions" + , "prelude" + , "psci-support" + , "spec" + , "transformers" + , "typeable" + ] +, packages = ./packages.dhall with typeable = ./spago.dhall as Location +, sources = [ "test/**/*.purs" ] +}