Make typeFun total

Author: Anton Chaynikov

src/Nix/Type/Infer.hs

@@ -706,8 +706,9 @@ unops :: Type -> NUnaryOp -> [Constraint]
 unops u1 op =
   [ EqConst u1
    (case op of
-      NNot -> typeFun [typeBool                   , typeBool                       ]
-      NNeg -> TMany   [typeFun  [typeInt, typeInt], typeFun  [typeFloat, typeFloat]]
+      NNot -> typeFun $ typeBool :| [typeBool]
+      NNeg -> TMany   [ typeFun $ typeInt :| [typeInt]
+                      , typeFun $ typeFloat :| [typeFloat] ]
     )
   ]
 
@@ -727,46 +728,46 @@ binops u1 op =
 
  where
 
-  gate          = eqCnst [typeBool, typeBool, typeBool]
-  concatenation = eqCnst [typeList, typeList, typeList]
+  gate          = eqCnst $ typeBool :| [typeBool, typeBool]
+  concatenation = eqCnst $ typeList :| [typeList, typeList]
 
-  eqCnst l = [EqConst u1 $ typeFun l]
+  eqCnst ne = [EqConst u1 $ typeFun ne]
 
   inequality =
     eqCnstMtx
-      [ [typeInt  , typeInt  , typeBool]
-      , [typeFloat, typeFloat, typeBool]
-      , [typeInt  , typeFloat, typeBool]
-      , [typeFloat, typeInt  , typeBool]
+      [ typeInt   :| [typeInt  , typeBool]
+      , typeFloat :| [typeFloat, typeBool]
+      , typeInt   :| [typeFloat, typeBool]
+      , typeFloat :| [typeInt  , typeBool]
       ]
 
   arithmetic =
     eqCnstMtx
-      [ [typeInt  , typeInt  , typeInt  ]
-      , [typeFloat, typeFloat, typeFloat]
-      , [typeInt  , typeFloat, typeFloat]
-      , [typeFloat, typeInt  , typeFloat]
+      [ typeInt   :| [typeInt  , typeInt  ]
+      , typeFloat :| [typeFloat, typeFloat]
+      , typeInt   :| [typeFloat, typeFloat]
+      , typeFloat :| [typeInt  , typeFloat]
       ]
 
   rUnion =
     eqCnstMtx
-      [ [typeSet , typeSet , typeSet]
-      , [typeSet , typeNull, typeSet]
-      , [typeNull, typeSet , typeSet]
+      [ typeSet  :| [typeSet , typeSet]
+      , typeSet  :| [typeNull, typeSet]
+      , typeNull :| [typeSet , typeSet]
       ]
 
   addition =
     eqCnstMtx
-      [ [typeInt   , typeInt   , typeInt   ]
-      , [typeFloat , typeFloat , typeFloat ]
-      , [typeInt   , typeFloat , typeFloat ]
-      , [typeFloat , typeInt   , typeFloat ]
-      , [typeString, typeString, typeString]
-      , [typePath  , typePath  , typePath  ]
-      , [typeString, typeString, typePath  ]
+      [ typeInt    :| [typeInt   , typeInt   ]
+      , typeFloat  :| [typeFloat , typeFloat ]
+      , typeInt    :| [typeFloat , typeFloat ]
+      , typeFloat  :| [typeInt   , typeFloat ]
+      , typeString :| [typeString, typeString]
+      , typePath   :| [typePath  , typePath  ]
+      , typeString :| [typeString, typePath  ]
       ]
 
-  eqCnstMtx mtx = [EqConst u1 $ TMany $ typeFun <$> mtx]
+  eqCnstMtx mtx = [EqConst u1 $ TMany $ map typeFun mtx]
 
 liftInfer :: Monad m => m a -> InferT s m a
 liftInfer = InferT . lift . lift . lift

src/Nix/Type/Type.hs

@@ -4,7 +4,6 @@
 module Nix.Type.Type where
 
 import           Prelude                 hiding ( Type, TVar )
-import           Data.Foldable                  ( foldr1 )
 import           Nix.Expr.Types
 
 -- | Hindrey-Milner type interface
@@ -39,9 +38,8 @@ typeSet = TSet mempty mempty
 typeList :: Type
 typeList = TList mempty
 
-typeFun :: [Type] -> Type
--- Please, replace with safe analog to `foldr1`
-typeFun = foldr1 (:~>)
+typeFun :: NonEmpty Type -> Type
+typeFun (head_ :| tail_) = foldr (:~>) head_ tail_
 
 -- | Concrete types in the Nix type system.
 typeInt, typeFloat, typeBool, typeString, typePath, typeNull :: Type