    -- |A code-generation system for complex typeclass default-implementation
    -- configurations.  There are usage examples in this package's source
    -- distribution[1] and in the random-source package[2].
    --
    -- 1. <https://github.com/mokus0/flexible-defaults/tree/master/examples>
    --
    -- 2. <https://github.com/mokus0/random-fu/blob/master/random-source/src/Data/Random/Internal/TH.hs>
    {-# LANGUAGE CPP #-}
    module Language.Haskell.TH.FlexibleDefaults
        ( Defaults
        , scoreBy
        , Function
        , function
        , requireFunction
        , Implementation
        , implementation
        , score
        , cost
        , dependsOn
        , inline
        , noinline

        , withDefaults
        , implementDefaults
        ) where

    import Data.List
    import Data.Ord
    #if !(MIN_VERSION_base(4,8,0))
    -- starting with base-4.8, Monoid is rexported from Prelude
    import Data.Monoid
    #endif
    import qualified Data.Map as M
    import qualified Data.Set as S
    import Language.Haskell.TH
    import Language.Haskell.TH.Extras
    import Language.Haskell.TH.FlexibleDefaults.DSL
    import Language.Haskell.TH.FlexibleDefaults.Solve

    deleteKeys :: Ord k => S.Set k -> M.Map k v -> M.Map k v
    deleteKeys :: forall k v. Ord k => Set k -> Map k v -> Map k v
    deleteKeys Set k
    ks Map k v
    m = Map k v
    m Map k v -> Map k () -> Map k v
    forall k a b. Ord k => Map k a -> Map k b -> Map k a
    M.\\ [(k, ())] -> Map k ()
    forall k a. [(k, a)] -> Map k a
    M.fromDistinctAscList [(k
    k,()) | k
    k <- Set k -> [k]
    forall a. Set a -> [a]
    S.toAscList Set k
    ks]

    -- |Given a partial list of function declarations, complete that list based on
    -- the 'Defaults' specification given.
    implementDefaults :: (Ord s, Monoid s) => Defaults s () -> [Dec] -> Q [Dec]
    implementDefaults :: forall s. (Ord s, Monoid s) => Defaults s () -> [Dec] -> Q [Dec]
    implementDefaults Defaults s ()
    defs [Dec]
    futzedDecs = do
        let decs :: [Dec]
    decs = [Dec] -> [Dec]
    genericalizeDecs [Dec]
    futzedDecs
            prob :: Problem s
    prob = Defaults s () -> Problem s
    forall s. (Ord s, Monoid s) => Defaults s () -> Problem s
    toProblem Defaults s ()
    defs

            implemented :: Set String
    implemented = [String] -> Set String
    forall a. Ord a => [a] -> Set a
    S.fromList ((Name -> String) -> [Name] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map Name -> String
    nameBase ((Dec -> [Name]) -> [Dec] -> [Name]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap Dec -> [Name]
    namesBoundInDec [Dec]
    decs))
            unimplemented :: Problem s
    unimplemented = Set String -> Problem s -> Problem s
    forall k v. Ord k => Set k -> Map k v -> Map k v
    deleteKeys Set String
    implemented Problem s
    prob

            solutions :: [Solution s]
    solutions = Problem s -> [Solution s]
    forall s. Problem s -> [Solution s]
    chooseImplementations Problem s
    unimplemented

        implementations <- case [Solution s]
    solutions of
            []  -> String -> Q [[Dec]]
    forall a. String -> Q a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "implementDefaults: incomplete set of basis functions"
            [Solution s]
    ss  ->
                let best :: Solution s
    best = (Solution s -> Solution s -> Ordering)
    -> [Solution s] -> Solution s
    forall (t :: * -> *) a.
    Foldable t =>
    (a -> a -> Ordering) -> t a -> a
    maximumBy ((Solution s -> s) -> Solution s -> Solution s -> Ordering
    forall a b. Ord a => (b -> a) -> b -> b -> Ordering
    comparing Solution s -> s
    forall s. Monoid s => Solution s -> s
    scoreSolution) [Solution s]
    ss
                 in [Q [Dec]] -> Q [[Dec]]
    forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    forall (m :: * -> *) a. Monad m => [m a] -> m [a]
    sequence [ Q [Dec]
    decQ | ImplSpec Maybe s
    _ Set String
    _ Q [Dec]
    decQ <- Solution s -> [ImplSpec s]
    forall k a. Map k a -> [a]
    M.elems Solution s
    best]

        return (decs ++ concat implementations)

    -- TODO: maybe make this accept multiple instance declarations, and/or pass non-instance Dec's unmodified.
    -- Or even accept something like "M.Map String (exists s. Defaults s)" to support
    -- many different instance decls, choosing the 'Defaults' spec by class name.

    -- |Given a @Q [Dec]@ containing an instance declaration, complete that instance
    -- declaration using the given 'Defaults' specification.  Typical usage would be
    -- along the lines of the following:
    --
    -- > $(withDefaults fooDefaults [d| instance Foo t where {- ... -} |])
    withDefaults :: (Monoid s, Ord s) => Defaults s () -> Q [Dec] -> Q [Dec]
    withDefaults :: forall s. (Monoid s, Ord s) => Defaults s () -> Q [Dec] -> Q [Dec]
    withDefaults Defaults s ()
    defs Q [Dec]
    decQ = do
        dec <- Q [Dec]
    decQ

        case dec of
    #if MIN_VERSION_template_haskell(2,11,0)
            [InstanceD Maybe Overlap
    ol Cxt
    clsCxt Type
    cls [Dec]
    decs] -> do
                impl <- Defaults s () -> [Dec] -> Q [Dec]
    forall s. (Ord s, Monoid s) => Defaults s () -> [Dec] -> Q [Dec]
    implementDefaults Defaults s ()
    defs [Dec]
    decs
                return [InstanceD ol clsCxt cls impl]
    #else
            [InstanceD clsCxt cls decs] -> do
                impl <- implementDefaults defs decs
                return [InstanceD clsCxt cls impl]
    #endif

            [Dec]
    _ -> String -> Q [Dec]
    forall a. String -> Q a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "withDefaults: second parameter should be a single instance declaration"