{-# LANGUAGE TypeFamilies, TypeFamilyDependencies, UndecidableInstances #-}

import Text.Printf

class Subparser a where
  type ParsedString a = result | result -> a
  parse_string :: String -> ParsedString a

-- Parser which converts the string "foo" into `IsFoo`
-- and all other strings into `IsNotFoo`.
data FooParser
data Foo = IsFoo | IsNotFoo deriving Show
instance Subparser FooParser where
  type ParsedString FooParser = Foo
  parse_string "foo" = IsFoo
  parse_string _ = IsNotFoo

-- Parser which converts the string "bar" into `IsBar`
-- and all other strings into `IsNotBar`.
data BarParser
data Bar = IsBar | IsNotBar deriving Show
instance Subparser BarParser where
  type ParsedString BarParser = Bar
  parse_string "bar" = IsBar
  parse_string _ = IsNotBar

-- Example aggregate data type containing the parsed output,
-- to show how to configure a parser using multiple associated types.
data ParsedOutput a b = ParsedOutput
  { foo :: ParsedString a,
    bar :: ParsedString b
  }

-- Implement `Show` for `ParsedOutput` only if both of the parsed result
-- types can be `Show`n as well.
-- NB: this requires `UndecidableInstances`, or else the compiler rejects
-- it with: Illegal nested constraint ‘Show (ParsedString a)’
instance (Show (ParsedString a), Show (ParsedString b)) => Show (ParsedOutput a b) where
  show (ParsedOutput {foo, bar}) = printf "{ foo = %s, bar = %s }" (show foo) (show bar)

-- Given two sub-parsers `a` and `b` which satisfy `Subparser`, run our
-- parser using both of those sub-parsers as necessary.
--
-- Note that we never create an instance of the subparser types.
-- Indeed, it's not possible as written since e.g. `data FooParser` has
-- no constructors and can't be instantiated. We could add a constructor
-- to the `Subparser` class if we wanted to have a way to construct an
-- arbitrary sub-parser, or we could require that the caller pass in
-- a value of type `Subparser a`, which would require the caller to
-- construct the sub-parser for us.
parse :: (Subparser a, Subparser b) => String -> ParsedOutput a b
parse s = ParsedOutput {foo = parse_string s, bar = parse_string s}

type FooBarOutput = ParsedOutput FooParser BarParser
main = do
  -- The type annotations are necessary to declare which parsers to use.
  print $ (parse "foo" :: FooBarOutput)
  print $ (parse "bar" :: FooBarOutput)