Merge pull request #223 from unisonweb/fix/unarrows

fix unArrows and add a simple test for it

parser-typechecker/src/Unison/Type.hs

@@ -102,10 +102,10 @@ pattern Universal' v <- ABT.Var' (TypeVar.Universal v)
 
 unArrows :: AnnotatedType v a -> Maybe [AnnotatedType v a]
 unArrows t =
-  case go t of [] -> Nothing; l -> Just l
+  case go t of [_] -> Nothing; l -> Just l
   where
     go (Arrow' i o) = i : go o
-    go _ = []
+    go o = [o]
 
 unApps :: AnnotatedType v a -> Maybe (AnnotatedType v a, [AnnotatedType v a])
 unApps t = case go t [] of [] -> Nothing; [_] -> Nothing; f:args -> Just (f,args)

parser-typechecker/tests/Suite.hs

@@ -10,6 +10,7 @@ import qualified Unison.Test.FileParser as FileParser
 import qualified Unison.Test.Lexer as Lexer
 import qualified Unison.Test.Range as Range
 import qualified Unison.Test.TermParser as TermParser
+import qualified Unison.Test.Type as Type
 import qualified Unison.Test.Typechecker as Typechecker
 import qualified Unison.Test.ColorText as ColorText
 
@@ -17,6 +18,7 @@ test :: Test ()
 test = tests
   [ Lexer.test
   , TermParser.test
+  , Type.test
   , Typechecker.test
   , FileParser.test
   , DataDeclaration.test

parser-typechecker/tests/Unison/Test/Type.hs

@@ -0,0 +1,17 @@
+{-# Language OverloadedStrings #-}
+
+module Unison.Test.Type where
+
+import EasyTest
+import Unison.Type
+import Unison.Symbol (Symbol)
+
+test :: Test ()
+test = scope "type" $ tests [
+  scope "unArrows" $
+    let x = arrow() (builtin() "a") (builtin() "b") :: Type Symbol
+    in case x of
+         Arrows' [i,o] ->
+           expect (i == builtin() "a" && o == builtin() "b")
+         _ -> crash "unArrows (a -> b) did not return a spine of [a,b]"
+  ]

parser-typechecker/unison-parser-typechecker.cabal

@@ -143,6 +143,7 @@ executable tests
     Unison.Test.Range
     Unison.Test.TermParser
     Unison.Test.Typechecker
+    Unison.Test.Type
     Unison.Test.Typechecker.Components
 
   build-depends: