<html>
<head>
<meta http-equiv="content-type" content="text/html; charset=utf-8">
</head>
<body text="#000000" bgcolor="#FFFFFF">
<p>Hello, everyone!</p>
<p>I want to call one function (or the same but with a special
argument, no matter) if a type instantiates some type-class or
another - if not. I know that it's easy in languages like D, Java,
possible C++ - we can specialize templates more generic or less
generic and to restrict its parameters with class/interface
implementation/extending (there are special keywords/type
operators for it, used in generics/templates signatures). So, I
suppose Haskell can do the same. But as it turned out, this is not
so easy for Haskell :(</p>
<p>I found these useful links:</p>
<ul>
<li><a class="moz-txt-link-freetext" href="https://stackoverflow.com/questions/26303353/can-multiple-dispatch-be-achieved-in-haskell-with-pattern-matching-on-type-class">https://stackoverflow.com/questions/26303353/can-multiple-dispatch-be-achieved-in-haskell-with-pattern-matching-on-type-class</a></li>
<li><a class="moz-txt-link-freetext" href="https://wiki.haskell.org/GHC/AdvancedOverlap">https://wiki.haskell.org/GHC/AdvancedOverlap</a></li>
</ul>
<p>So, I wrote something like this (this example is compiling and
works as I expect, you need `mustache` and `network-uri`
packages). Goal is to substitute type in special way for HTML
template and for text template if type implements a special
interface (for deterministic substitution). Otherwise default
substitution will be used. Actually, this code allows usage of not
only HTML/text templates... OK, here it is:</p>
<p><br>
</p>
<blockquote>
<p>{-# LANGUAGE EmptyDataDecls #-}<br>
{-# LANGUAGE FlexibleInstances #-}<br>
{-# LANGUAGE FunctionalDependencies #-}<br>
{-# LANGUAGE MultiParamTypeClasses #-}<br>
{-# LANGUAGE OverloadedStrings #-}<br>
{-# LANGUAGE ScopedTypeVariables #-}<br>
{-# LANGUAGE TypeFamilies #-}<br>
{-# LANGUAGE UndecidableInstances #-}<br>
<br>
import Data.Semigroup ((<>))<br>
import qualified Data.Text as T<br>
import Network.URI<br>
import qualified Text.Mustache.Types as MUT<br>
<br>
<br>
type Link = (T.Text, URI) -- caption and URL, for example<br>
<br>
<br>
-- |Converts a type to substitutable to Mustache template entity
based on 'SubTo' template selector.<br>
-- @sub@ must be ignored in implementation<br>
class ToMustaches sub a where<br>
toMustaches :: sub -> a -> SubTo -> MUT.Value<br>
<br>
-- |Substituted to HTML either to text<br>
data SubTo = ToHtml | ToText<br>
<br>
-- |Deterministic substitution<br>
data DetSub<br>
-- |Universal substitution<br>
data UniSub<br>
<br>
-- |Substitution predicate: it's determined uniquely for type<br>
class SubPred a sub | a -> sub<br>
<br>
-- TODO rename ToMustaches' (ToMustaches' ?)<br>
class ToMustaches' a where<br>
toMustaches' :: a -> SubTo -> MUT.Value<br>
instance (SubPred a sub, ToMustaches sub a) => ToMustaches' a
where<br>
toMustaches' a to = toMustaches (undefined::sub) a to<br>
<br>
-- See:<br>
-- *
<a class="moz-txt-link-freetext" href="https://stackoverflow.com/questions/36913922/how-to-resolve-overlapping-instance">https://stackoverflow.com/questions/36913922/how-to-resolve-overlapping-instance</a><br>
-- *
<a class="moz-txt-link-freetext" href="https://stackoverflow.com/questions/26303353/can-multiple-dispatch-be-achieved-in-haskell-with-pattern-matching-on-type-class">https://stackoverflow.com/questions/26303353/can-multiple-dispatch-be-achieved-in-haskell-with-pattern-matching-on-type-class</a><br>
instance {-# OVERLAPS #-} (sub ~ UniSub) => SubPred a sub<br>
<br>
-- 'Link' can be substituted deterministically<br>
instance SubPred Link DetSub<br>
instance ToMustaches DetSub Link where<br>
toMustaches _ (_, url) ToText = MUT.String $ T.pack $ show
url<br>
toMustaches _ (cap, url) ToHtml = MUT.String ("<a href=\""
<> (T.pack $ show url) <> "\">" <> cap
<> "</a>")<br>
<br>
-- |All other types which does not implements 'ToMustaches'
default instance transforms them to string w/ 'Show'<br>
instance Show a => ToMustaches UniSub a where<br>
toMustaches _ a _ = MUT.String $ T.pack $ show a<br>
<br>
-------------------------------------------------------------------<br>
main :: IO ()<br>
main = do<br>
let<br>
uri = URI "http:" (Just $ URIAuth "" "wikipedia.org" "") ""
"" ""<br>
lnk = ("wikipedia", uri)::Link<br>
txt = "Hello world"::T.Text<br>
n = 444::Int<br>
print $ toMustaches' lnk ToText<br>
print $ toMustaches' lnk ToHtml<br>
print $ toMustaches' txt ToHtml<br>
print $ toMustaches' n ToText<br>
</p>
</blockquote>
<p><br>
</p>
<p>I don't know am I understand correctly the Haskell solution but
this looks close to explained in the Haskell Wiki (case 1). But in
all cases I see problem: always I need not only to implement this
special interface but to "say" that a type implements special
(deterministic) substitution, see:</p>
<blockquote>
<p>instance SubPred Link DetSub</p>
</blockquote>
<p>This means that clients of this code must "implements" 2
instances: 1) of ToMustaches and 2) of SubPred (with DetSub as
last type param). This is terrible and no such thing in other
languages! So, my question is: is a simple way to avoid it?</p>
<p><br>
</p>
<p>===</p>
<p>Best regards, Paul<br>
</p>
</body>
</html>