    module Data.Singletons.Single.Fixity where

    import Prelude hiding ( exp )
    import Language.Haskell.TH hiding ( cxt )
    import Language.Haskell.TH.Syntax (NameSpace(..), Quasi(..))
    import Data.Singletons.Util
    import Data.Singletons.Names
    import Language.Haskell.TH.Desugar

    singInfixDecl :: DsMonad q => Name -> Fixity -> q DLetDec
    singInfixDecl :: Name -> Fixity -> q DLetDec
    singInfixDecl name :: Name
    name fixity :: Fixity
    fixity = do
      Maybe NameSpace
    mb_ns <- Name -> q (Maybe NameSpace)
    forall (q :: * -> *). DsMonad q => Name -> q (Maybe NameSpace)
    reifyNameSpace Name
    name
      DLetDec -> q DLetDec
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (DLetDec -> q DLetDec) -> DLetDec -> q DLetDec
    forall a b. (a -> b) -> a -> b
    $ Fixity -> Name -> DLetDec
    DInfixD Fixity
    fixity
           (Name -> DLetDec) -> Name -> DLetDec
    forall a b. (a -> b) -> a -> b
    $ case Maybe NameSpace
    mb_ns of
               Just TcClsName -> Name -> Name
    singTyConName Name
    name
               Just DataName  -> Name -> Name
    singDataConName Name
    name
               Just VarName   -> Name -> Name
    singValName Name
    name
               -- If we can't find the Name for some odd reason,
               -- fall back to singValName
               Nothing        -> Name -> Name
    singValName Name
    name

    singFixityDeclaration :: DsMonad q => Name -> q [DDec]
    singFixityDeclaration :: Name -> q [DDec]
    singFixityDeclaration name :: Name
    name = do
      Maybe Fixity
    mFixity <- Name -> q (Maybe Fixity)
    forall (m :: * -> *). Quasi m => Name -> m (Maybe Fixity)
    qReifyFixity Name
    name
      case Maybe Fixity
    mFixity of
        Nothing     -> [DDec] -> q [DDec]
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure []
        Just fixity :: Fixity
    fixity -> [q DDec] -> q [DDec]
    forall (t :: * -> *) (f :: * -> *) a.
    (Traversable t, Applicative f) =>
    t (f a) -> f (t a)
    sequenceA [DLetDec -> DDec
    DLetDec (DLetDec -> DDec) -> q DLetDec -> q DDec
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Name -> Fixity -> q DLetDec
    forall (q :: * -> *). DsMonad q => Name -> Fixity -> q DLetDec
    singInfixDecl Name
    name Fixity
    fixity]

    singFixityDeclarations :: DsMonad q => [Name] -> q [DDec]
    singFixityDeclarations :: [Name] -> q [DDec]
    singFixityDeclarations = (Name -> q [DDec]) -> [Name] -> q [DDec]
    forall (monad :: * -> *) monoid (t :: * -> *) a.
    (Monad monad, Monoid monoid, Traversable t) =>
    (a -> monad monoid) -> t a -> monad monoid
    concatMapM Name -> q [DDec]
    forall (m :: * -> *). DsMonad m => Name -> m [DDec]
    trySingFixityDeclaration
      where
        trySingFixityDeclaration :: Name -> m [DDec]
    trySingFixityDeclaration name :: Name
    name =
          m [DDec] -> m [DDec] -> m [DDec]
    forall (m :: * -> *) a. Quasi m => m a -> m a -> m a
    qRecover ([DDec] -> m [DDec]
    forall (m :: * -> *) a. Monad m => a -> m a
    return []) (Name -> m [DDec]
    forall (m :: * -> *). DsMonad m => Name -> m [DDec]
    singFixityDeclaration Name
    name)