{-# LANGUAGE AllowAmbiguousTypes    #-}
{-# LANGUAGE DataKinds              #-}
{-# LANGUAGE FlexibleInstances      #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE PolyKinds              #-}
{-# LANGUAGE TypeFamilies           #-}
{-# LANGUAGE TypeOperators          #-}
{-# LANGUAGE UndecidableInstances   #-}
module Overloaded.Constructors where

import Data.Kind (Type)

-- | Class for the overloaded constructors.
--
-- Instances for this class are automatically generated by type-checker
-- plugin, but you may also defined your own. See an example instances for 'Either'.
--
-- @
-- {-\# OPTIONS -fplugin=Overloaded -fplugin-opt=Overloaded:Constructors #-}
-- @
--
-- Additionally, this overload steals syntax transforming all
-- @(:name arg1 arg2)@ into @'build' \@"name" (arg1, arg2)@ expressions.
-- Parenthesis are important as standalone @:name@ is (for now) not valid
-- Haskell syntax and they also naturally delimit the arguments.
--
-- For nullary constructors the @a@ type is unit @()@,
-- for unary the type is used as is,
-- and for others the parameters are wrapped into a tuple.
-- The last case is not particularly pretty, but its overloadable.
--
--
class HasConstructor x (s :: Type) (a :: Type) | x s -> a where
    build :: a -> s
    match :: s -> Maybe a

-------------------------------------------------------------------------------
-- An example
-------------------------------------------------------------------------------

instance a' ~ a => HasConstructor "Left" (Either a b) a' where
    build :: a' -> Either a b
build = a' -> Either a b
forall a b. a -> Either a b
Left
    match :: Either a b -> Maybe a'
match = \Either a b
s -> case Either a b
s of
        Left a
a  -> a -> Maybe a
forall a. a -> Maybe a
Just a
a
        Right b
_ -> Maybe a'
forall a. Maybe a
Nothing

instance a' ~ b => HasConstructor "Right" (Either a b) a' where
    build :: a' -> Either a b
build = a' -> Either a b
forall a b. b -> Either a b
Right
    match :: Either a b -> Maybe a'
match = \Either a b
s -> case Either a b
s of
        Left a
_  -> Maybe a'
forall a. Maybe a
Nothing
        Right b
b -> b -> Maybe b
forall a. a -> Maybe a
Just b
b