[Haskell-cafe] overloading functions
Damien Mattei
mattei at oca.eu
Thu Jan 10 14:15:59 UTC 2019
yes for use with the DB (Database.MySQL.Simple.QueryResults) it is
necessary.
It should be confusing about String for the compiler...
Le 10/01/2019 13:00, Ivan Lazar Miljenovic a écrit :
>
> On Thu, 10 Jan 2019 at 19:34, Damien Mattei <mattei at oca.eu
> <mailto:mattei at oca.eu>> wrote:
>
> Hi,
>
> i have this definition:
>
> {-# LANGUAGE FlexibleInstances #-}
>
> class ConcatenateMaybeString a where
> cms :: Maybe String -> a -> Maybe String
>
>
> instance ConcatenateMaybeString (Maybe String) where
> cms mf ms =
> mf >>= (\f ->
> ms >>= (\s ->
> return (f ++ s)))
>
>
>
> instance ConcatenateMaybeString String where
> cms mf s =
> mf >>= (\f -> return (f ++ s))
>
> when i use it on :
> f `cms` ("." ::String) `cms` s
> it works
>
> but not on this:
> f `cms` "." `cms` s
>
> "." is too ambigious to compile:
>
> *Main> :load UpdateSidonie
> [1 of 1] Compiling Main ( UpdateSidonie.hs, interpreted )
>
> UpdateSidonie.hs:373:43: error:
> • Ambiguous type variable ‘a0’ arising from a use of ‘cms’
> prevents the constraint ‘(ConcatenateMaybeString
> a0)’ from being solved.
> Probable fix: use a type annotation to specify what ‘a0’
> should be.
> These potential instances exist:
> instance ConcatenateMaybeString (Maybe String)
> -- Defined at UpdateSidonie.hs:169:11
> instance ConcatenateMaybeString String
> -- Defined at UpdateSidonie.hs:177:11
> • In the first argument of ‘cms’, namely ‘f `cms` "."’
> In the expression: f `cms` "." `cms` s
> In the expression:
> let
> f = fmap head resBDwords
> s = fmap (head . tail) resBDwords
> mp = Just "." :: Maybe String
> ....
> in f `cms` "." `cms` s
> |
> 373 | in f `cms` "." `cms` s) ::
> Maybe String
> | ^^^^^^^^^^^
>
> UpdateSidonie.hs:373:51: error:
> • Ambiguous type variable ‘a0’ arising from the literal ‘"."’
> prevents the constraint ‘(Data.String.IsString
> a0)’ from being solved.
> Probable fix: use a type annotation to specify what ‘a0’
> should be.
> These potential instances exist:
> instance Data.String.IsString Query
> -- Defined in ‘Database.MySQL.Simple.Types’
> instance Data.String.IsString Tx.Text -- Defined in ‘Data.Text’
> instance (a ~ Char) => Data.String.IsString [a]
> -- Defined in ‘Data.String’
> ...plus six instances involving out-of-scope types
> (use -fprint-potential-instances to see them all)
> • In the second argument of ‘cms’, namely ‘"."’
> In the first argument of ‘cms’, namely ‘f `cms` "."’
> In the expression: f `cms` "." `cms` s
> |
> 373 | in f `cms` "." `cms` s) ::
> Maybe String
> | ^^^
> Failed, no modules loaded.
> Prelude>
>
>
> any idea?
>
>
> Do you have the OverloadedStrings or OverloadedLists LANGUAGE pragmas
> enabled?
>
>
>
> Damien
>
> _______________________________________________
> Haskell-Cafe mailing list
> To (un)subscribe, modify options or view archives go to:
> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe
> Only members subscribed via the mailman list are allowed to post.
>
>
>
> --
> Ivan Lazar Miljenovic
> Ivan.Miljenovic at gmail.com <mailto:Ivan.Miljenovic at gmail.com>
> http://IvanMiljenovic.wordpress.com
More information about the Haskell-Cafe
mailing list