[Haskell-cafe] Selda: confused about type signtures

Li-yao Xia lysxia at gmail.com
Mon Apr 23 11:58:56 UTC 2018


Hi Marc,

> ```
> list :: (Result (Cols s a), Columns (Cols s a))  => Table a -> IO [Res 
> (Cols s a)]
> list table = withDB $ query (select table)
> ```

The only occurence of `s`/`s0` that is not ambiguous is between `select` 
and `query`, as the first argument of the data type `Query`. Everywhere 
else, there is a type family in the way which prevents unification; for 
example `Cols s a ~ Cols s0 a` does not imply `s ~ s0`.

You can use a type annotation or TypeApplications to instantiate the 
`s0` between `query` and `select`. This requires ScopedTypeVariables, 
and an explicit `forall` at the top to make the type variables available 
in the definition body.

Note that the type of `list` is also ambiguous for the aforementioned 
reasons, since `s` is only an argument of the type family `Res` (and 
`Cols`). You will have to AllowAmbiguousTypes to define it and write 
`list @s` (with TypeApplications) to use it.

```
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}

list :: forall s a. (Result (Cols s a), Columns (Cols s a))
      => Table a -> IO [Res (Cols s a)]
list table = withDB $ query (select table :: Query s _)
-- or,                  ... (select @s table)
-- with {-# LANGUAGE TypeApplications #-}
```

References in the GHC manual:

- ScopedTypeVariables: 
https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/glasgow_exts.html#lexically-scoped-type-variables

- TypeApplications: 
https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/glasgow_exts.html#visible-type-application

- AllowAmbiguousTypes: 
https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/glasgow_exts.html#ambiguous-types-and-the-ambiguity-check

Li-yao


More information about the Haskell-Cafe mailing list