CODEWITHSUNDEEP
haskell
Alexander Polakov
Alexander Polakov

Reputation: 3

Overlapping sum types

Imagine I'm writing a webserver, and I want my config to look like this (took some inspiration from nginx):

listen = "localhost"
set error_page = "fail.html"

vhost "hello" {
  set error_page = "oops.html"
  path = "/var/www/hello/public_html"
}

Some directives, like Listen, can only be used in global scope, others are only available in vhost scope (Path), and some, like Set, are universal, which means I can't use regular ADTs like this:

data GlobalDirective = Listen Text | VirtualHost Text | Set Text Text
data LocalDirective = Path Text | Set Text Text

So I write this code which seems to reflect my mental model:

class Show a => Directive a 
class Directive a => GlobalDirective a
class Directive a => LocalDirective a

data GlobalConfig where
    GlobalDirectives :: forall a. GlobalDirective a => [a] -> GlobalConfig 
instance Show GlobalConfig where
    show (GlobalDirectives xs) = "Config" ++ show xs

data VirtualHost where  
    VirtualHostDirectives :: forall a. LocalDirective a => Text -> [a] -> VirtualHost 
instance Directive VirtualHost
instance GlobalDirective VirtualHost
instance Show VirtualHost where
    show (VirtualHostDirectives name xs) = "VirtualHost[" ++ show name ++ "]" ++ show xs

data Listen = Listen Text deriving (Show) 
instance Directive Listen
instance GlobalDirective Listen

data Set = Set Text Text deriving (Show)
instance Directive Set
instance GlobalDirective Set
instance LocalDirective Set

data Path = Path Text deriving (Show)
instance Directive Path
instance LocalDirective Path

The problem is that I can't actually construct the config:

> VirtualHostDirectives (Text.pack "hello") [Set (Text.pack "error_page") (Text.pack "oops.html"), Path (Text.pack "/var/www") ]

<interactive>:139:98:
    Couldn't match expected type ‘Set’ with actual type ‘Path’
    In the expression: Path (Text.pack "/var/www")
    In the second argument of ‘VirtualHostDirectives’, namely
      ‘[Set (Text.pack "error_page") (Text.pack "oops.html"),
        Path (Text.pack "/var/www")]’

This looks like a case for an existential quantification hack:

data AnyDirective a = forall a. Directive a => AnyDirective a
instance Directive (AnyDirective a)
instance Show (AnyDirective a) where
    show (AnyDirective a) = show a
instance GlobalDirective a => GlobalDirective (AnyDirective a)
instance LocalDirective a => LocalDirective (AnyDirective a)

...but it doesn't work either:

*Main> VirtualHostDirectives (Text.pack "hello") [AnyDirective $ Set (Text.pack "error_page") (Text.pack "oops.html"), AnyDirective $ Path (Text.pack "/var/www") ]

<interactive>:134:1:
    No instance for (LocalDirective a0)
      arising from a use of ‘VirtualHostDirectives’
    The type variable ‘a0’ is ambiguous
    Note: there are several potential instances:
      instance LocalDirective Path -- Defined at src/Main.hs:167:10
      instance LocalDirective Set -- Defined at src/Main.hs:163:10
      instance LocalDirective a => LocalDirective (AnyDirective a)
        -- Defined at src/Main.hs:142:10
    In the expression:
      VirtualHostDirectives
        (Text.pack "hello")
        [AnyDirective
         $ Set (Text.pack "error_page") (Text.pack "oops.html"),
         AnyDirective $ Path (Text.pack "/var/www")]
    In an equation for ‘it’:
        it
          = VirtualHostDirectives
              (Text.pack "hello")
              [AnyDirective
               $ Set (Text.pack "error_page") (Text.pack "oops.html"),
               AnyDirective $ Path (Text.pack "/var/www")]

So, what are my options here?

Upvotes: 0

Views: 115

Answers (2)

Daniel Wagner
Daniel Wagner

Reputation: 153257

One possibility would be to have a GADT with a phantom parameter:

{-# LANGUAGE GADTs, DataKinds #-}
import Data.Text
data Scope = Local | Global
data Directive a where
    Set         :: Text -> Text -> Directive a
    Path        :: Text -> Directive Local
    Listen      :: Text -> Directive Global
    VirtualHost :: Text -> Directive Global

You can see in ghci that this gives some pretty nice inference:

> :set -XOverloadedStrings
> :t [Set "error_page" "oops.html", Path "/var/www"]
[Set "error_page" "oops.html", Path "/var/www"] :: [Directive 'Local]

Upvotes: 5

amalloy
amalloy

Reputation: 92117

You can perfectly well do this with just ordinary ADTs - the only reason you're having trouble is because of the name conflict between the two data constructors:

Set :: Text -> Text -> GlobalDirective
Set :: Text -> Text -> LocalDirective

The simplest solution would be to just give them different names:

data GlobalDirective = Listen Text | VirtualHost Text | GSet Text Text
data LocalDirective = Path Text | LSet Text Text

That might even make the most semantic sense, if global sets are different from local sets in some way. Of course, you can't pass a generic Set to any function, because it has to know whether it's getting a global or local set. So you can clean this up a bit by defining a reusable Set that holds two Texts, and pass that around instead:

data Set = Set Text Text
data GlobalDirective = Listen Text | VirtualHost Text | GSet Set
data LocalDirective = Path Text | LSet Set

whatever :: Set -> Bool
whatever (Set name value) = True

handle :: LocalDirective -> Bool
handle (Path _) = False
handle (LSet s) = whatever s

Given how simple this is to do with ordinary ADTs, I don't think there is any need to bring in fancier stuff like existential types or typeclasses.

Upvotes: 2

Related Questions