    {-# LANGUAGE CPP                        #-}
    {-# LANGUAGE FlexibleContexts           #-}
    {-# LANGUAGE FlexibleInstances          #-}
    {-# LANGUAGE GeneralizedNewtypeDeriving #-}
    {-# LANGUAGE MultiParamTypeClasses      #-}
    {-# LANGUAGE TypeFamilies               #-}
    {-# LANGUAGE TypeOperators              #-}
    {-# LANGUAGE TypeSynonymInstances       #-}
    {-# LANGUAGE UndecidableInstances       #-}
    #if __GLASGOW_HASKELL__ < 710
    {-# LANGUAGE OverlappingInstances       #-}
    #endif

    {-# OPTIONS_GHC -fno-warn-orphans #-}

    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Data.Monoid.MList
    -- Copyright   :  (c) 2011 diagrams-core team (see LICENSE)
    -- License     :  BSD-style (see LICENSE)
    -- Maintainer  :  diagrams-discuss@googlegroups.com
    --
    -- Heterogeneous lists of monoids.
    --
    -----------------------------------------------------------------------------
    module Data.Monoid.MList
           ( -- * Heterogeneous monoidal lists

             -- $mlist

             (:::), (*:)

           , MList(..)

             -- * Accessing embedded values
           , (:>:)(..)

             -- * Monoid actions of heterogeneous lists

             -- $mlist-actions

           , SM(..)
           ) where

    import           Control.Arrow
    import           Data.Monoid.Action

    -- $mlist
    --
    -- The idea of /heterogeneous lists/ has been around for a long time.
    -- Here, we adopt heterogeneous lists where the element types are all
    -- monoids: this allows us to leave out identity values, so that a
    -- heterogeneous list containing only a single non-identity value can
    -- be created without incurring constraints due to all the other
    -- types, by leaving all the other values out.

    infixr 5 :::
    infixr 5 *:

    type a ::: l = (Maybe a, l)

    (*:) :: a -> l -> a ::: l
    a
    a *: :: forall a l. a -> l -> a ::: l
    *: l
    l = (a -> Maybe a
    forall a. a -> Maybe a
    Just a
    a, l
    l)

    -- MList -----------------------------------

    -- | Type class for heterogeneous monoidal lists, with a single method
    --   allowing construction of an empty list.
    class MList l where
      -- | The /empty/ heterogeneous list of type @l@. Of course, @empty
      -- == 'mempty'@, but unlike 'mempty', @empty@ does not require
      -- 'Monoid' constraints on all the elements of @l@.
      empty   :: l

    instance MList () where
      empty :: ()
    empty     = ()

    instance MList l => MList (a ::: l) where
      empty :: a ::: l
    empty   = (Maybe a
    forall a. Maybe a
    Nothing, l
    forall l. MList l => l
    empty)

    -- Embedding -------------------------------------------

    -- | The relation @l :>: a@ holds when @a@ is the type of an element
    --   in @l@.  For example,  @(Char ::: Int ::: Bool ::: Nil) :>: Int@.
    class l :>: a where
      -- | Inject a value into an otherwise empty heterogeneous list.
      inj  :: a -> l

      -- | Get the value of type @a@ from a heterogeneous list, if there
      --   is one.
      get  :: l -> Maybe a

      -- | Alter the value of type @a@ by applying the given function to it.
      alt  :: (Maybe a -> Maybe a) -> l -> l

    #if __GLASGOW_HASKELL__ >= 710
    instance {-# OVERLAPPING #-} MList t => (:>:) (a ::: t) a where
    #else
    instance MList t => (:>:) (a ::: t) a where
    #endif
      inj :: a -> a ::: t
    inj a
    a = (a -> Maybe a
    forall a. a -> Maybe a
    Just a
    a, t
    forall l. MList l => l
    empty)
      get :: (a ::: t) -> Maybe a
    get   = (a ::: t) -> Maybe a
    forall a b. (a, b) -> a
    fst
      alt :: (Maybe a -> Maybe a) -> (a ::: t) -> a ::: t
    alt   = (Maybe a -> Maybe a) -> (a ::: t) -> a ::: t
    forall b c d. (b -> c) -> (b, d) -> (c, d)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (b, d) (c, d)
    first

    instance (t :>: a) => (:>:) (b ::: t) a where
      inj :: a -> b ::: t
    inj a
    a = (Maybe b
    forall a. Maybe a
    Nothing, a -> t
    forall l a. (l :>: a) => a -> l
    inj a
    a)
      get :: (b ::: t) -> Maybe a
    get   = t -> Maybe a
    forall l a. (l :>: a) => l -> Maybe a
    get (t -> Maybe a) -> ((b ::: t) -> t) -> (b ::: t) -> Maybe a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (b ::: t) -> t
    forall a b. (a, b) -> b
    snd
      alt :: (Maybe a -> Maybe a) -> (b ::: t) -> b ::: t
    alt   = (t -> t) -> (b ::: t) -> b ::: t
    forall b c d. (b -> c) -> (d, b) -> (d, c)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (d, b) (d, c)
    second ((t -> t) -> (b ::: t) -> b ::: t)
    -> ((Maybe a -> Maybe a) -> t -> t)
    -> (Maybe a -> Maybe a)
    -> (b ::: t)
    -> b ::: t
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Maybe a -> Maybe a) -> t -> t
    forall l a. (l :>: a) => (Maybe a -> Maybe a) -> l -> l
    alt

    -- Monoid actions -----------------------------------------

    -- $mlist-actions
    -- Monoidal heterogeneous lists may act on one another as you would
    -- expect, with each element in the first list acting on each in the
    -- second.  Unfortunately, coding this up in type class instances is a
    -- bit fiddly.

    -- | @SM@, an abbreviation for \"single monoid\" (as opposed to a
    --   heterogeneous list of monoids), is only used internally to help
    --   guide instance selection when defining the action of
    --   heterogeneous monoidal lists on each other.
    newtype SM m = SM m
                   deriving Int -> SM m -> ShowS
    [SM m] -> ShowS
    SM m -> String
    (Int -> SM m -> ShowS)
    -> (SM m -> String) -> ([SM m] -> ShowS) -> Show (SM m)
    forall m. Show m => Int -> SM m -> ShowS
    forall m. Show m => [SM m] -> ShowS
    forall m. Show m => SM m -> String
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: forall m. Show m => Int -> SM m -> ShowS
    showsPrec :: Int -> SM m -> ShowS
    $cshow :: forall m. Show m => SM m -> String
    show :: SM m -> String
    $cshowList :: forall m. Show m => [SM m] -> ShowS
    showList :: [SM m] -> ShowS
    Show

    instance (Action (SM a) l2, Action l1 l2) => Action (a, l1) l2 where
      act :: (a, l1) -> l2 -> l2
    act (a
    a,l1
    l) = SM a -> l2 -> l2
    forall m s. Action m s => m -> s -> s
    act (a -> SM a
    forall m. m -> SM m
    SM a
    a) (l2 -> l2) -> (l2 -> l2) -> l2 -> l2
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . l1 -> l2 -> l2
    forall m s. Action m s => m -> s -> s
    act l1
    l

    instance Action (SM a) () where
      act :: SM a -> () -> ()
    act SM a
    _ ()
    _ = ()

    instance (Action a a', Action (SM a) l) => Action (SM a) (Maybe a', l) where
      act :: SM a -> (Maybe a', l) -> (Maybe a', l)
    act (SM a
    a) (Maybe a'
    Nothing,   l
    l) = (Maybe a'
    forall a. Maybe a
    Nothing, SM a -> l -> l
    forall m s. Action m s => m -> s -> s
    act (a -> SM a
    forall m. m -> SM m
    SM a
    a) l
    l)
      act (SM a
    a) (Just a'
    a', l
    l) = (a' -> Maybe a'
    forall a. a -> Maybe a
    Just (a -> a' -> a'
    forall m s. Action m s => m -> s -> s
    act a
    a a'
    a'), SM a -> l -> l
    forall m s. Action m s => m -> s -> s
    act (a -> SM a
    forall m. m -> SM m
    SM a
    a) l
    l)