-- This file is part of Qtah.
--
-- Copyright 2015-2023 The Qtah Authors.
--
-- This program is free software: you can redistribute it and/or modify
-- it under the terms of the GNU Lesser General Public License as published by
-- the Free Software Foundation, either version 3 of the License, or
-- (at your option) any later version.
--
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-- GNU Lesser General Public License for more details.
--
-- You should have received a copy of the GNU Lesser General Public License
-- along with this program.  If not, see <http://www.gnu.org/licenses/>.

module Graphics.UI.Qtah.Generator.Flags (
  -- * Data type
  Flags, flagsT,
  -- * Construction
  makeFlags,
  -- * Properties
  flagsExtName,
  flagsIdentifier,
  flagsEnum,
  flagsReqs,
  flagsAddendum,
  -- * Haskell generator
  -- ** Names
  toHsFlagsTypeName',
  toHsFlagsTypeclassName',
  toHsFlagsBindingName,
  toHsFlagsBindingName',
  ) where

import Control.Monad (forM_, when)
import Control.Monad.Except (throwError)
import qualified Data.Map as M
import qualified Foreign.Hoppy.Generator.Language.Cpp as LC
import qualified Foreign.Hoppy.Generator.Language.Haskell as LH
import Foreign.Hoppy.Generator.Spec (
  Addendum,
  Constness (Nonconst),
  ConversionMethod (CustomConversion),
  ConversionSpec,
  Exportable,
  ExtName,
  ForeignLanguage (Haskell),
  HasAddendum,
  HasExtNames,
  HasReqs,
  Identifier,
  Reqs,
  Type,
  conversionSpecCppConversionFromCppExpr,
  conversionSpecCppConversionToCppExpr,
  conversionSpecCppConversionType,
  conversionSpecHaskell,
  conversionSpecHaskellHsArgType,
  evaluatedEnumNumericType,
  evaluatedEnumValueMap,
  getAddendum,
  getPrimaryExtName,
  getReqs,
  hsImport1,
  hsImports,
  identifierParts,
  idPartBase,
  makeConversionSpec,
  makeConversionSpecCpp,
  makeConversionSpecHaskell,
  makeIdentifier,
  makeIdPart,
  modifyAddendum,
  modifyReqs,
  numType,
  sayExportCpp,
  sayExportHaskell,
  setAddendum,
  setReqs,
  toExtName,
  )
import qualified Foreign.Hoppy.Generator.Spec.Enum as Enum
import Foreign.Hoppy.Generator.Types (manualT)
import Graphics.UI.Qtah.Generator.Common (lowerFirst, replaceLast)
import Graphics.UI.Qtah.Generator.Interface.Imports (
  importForBits,
  importForFlags,
  importForPrelude,
  importForRuntime,
  )
import Language.Haskell.Syntax (
  HsName (HsIdent),
  HsQName (UnQual),
  HsQualType (HsQualType),
  HsType (HsTyCon, HsTyVar),
  )

-- | This is an exportable wrapper around a 'Enum.CppEnum' that also generates
-- support for a @QFlags\<Enum\>@ typedef.
--
-- This does not export any ExtNames of its own.
--
-- In generated Haskell code, in addition to what is generated for the
-- 'Enum.CppEnum', we generate a newtype wrapper around an enum value to
-- represent a combination of flags, and an @IsXXX@ typeclass for converting
-- various types (flags type, enum type, raw number) to a newtype'd value.
data Flags = Flags
  { Flags -> ExtName
flagsExtName :: ExtName
  , Flags -> Identifier
flagsIdentifier :: Identifier
  , Flags -> CppEnum
flagsEnum :: Enum.CppEnum
  , Flags -> Reqs
flagsReqs :: Reqs
  , Flags -> Addendum
flagsAddendum :: Addendum
  }

instance Show Flags where
  show :: Flags -> ErrorMsg
show Flags
flags =
    ErrorMsg
"<Flags " ErrorMsg -> ShowS
forall a. [a] -> [a] -> [a]
++
    ExtName -> ErrorMsg
forall a. Show a => a -> ErrorMsg
show (Flags -> ExtName
flagsExtName Flags
flags) ErrorMsg -> ShowS
forall a. [a] -> [a] -> [a]
++ ErrorMsg
" " ErrorMsg -> ShowS
forall a. [a] -> [a] -> [a]
++
    Identifier -> ErrorMsg
LC.renderIdentifier (Flags -> Identifier
flagsIdentifier Flags
flags) ErrorMsg -> ShowS
forall a. [a] -> [a] -> [a]
++ ErrorMsg
">"

instance HasAddendum Flags where
  getAddendum :: Flags -> Addendum
getAddendum = Flags -> Addendum
flagsAddendum
  setAddendum :: Addendum -> Flags -> Flags
setAddendum Addendum
a Flags
flags = Flags
flags { flagsAddendum = a }
  modifyAddendum :: (Addendum -> Addendum) -> Flags -> Flags
modifyAddendum Addendum -> Addendum
f Flags
flags = Flags
flags { flagsAddendum = f $ flagsAddendum flags }

instance HasExtNames Flags where
  getPrimaryExtName :: Flags -> ExtName
getPrimaryExtName = Flags -> ExtName
flagsExtName

instance HasReqs Flags where
  getReqs :: Flags -> Reqs
getReqs = Flags -> Reqs
flagsReqs
  setReqs :: Reqs -> Flags -> Flags
setReqs Reqs
r Flags
flags = Flags
flags { flagsReqs = r }
  modifyReqs :: (Reqs -> Reqs) -> Flags -> Flags
modifyReqs Reqs -> Reqs
f Flags
flags = Flags
flags { flagsReqs = f $ flagsReqs flags }

instance Exportable Flags where
  -- Nothing to generate for flags here.  (Enums don't have any generated C++
  -- code here either.)
  sayExportCpp :: SayExportMode -> Flags -> Generator ()
sayExportCpp SayExportMode
_ Flags
_ = () -> Generator ()
forall a. a -> ReaderT Env (WriterT [Chunk] (Either ErrorMsg)) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

  sayExportHaskell :: SayExportMode -> Flags -> Generator ()
sayExportHaskell SayExportMode
mode Flags
flags = SayExportMode -> Flags -> Generator ()
sayHsExport SayExportMode
mode Flags
flags

makeFlags :: Enum.CppEnum -> String -> Flags
makeFlags :: CppEnum -> ErrorMsg -> Flags
makeFlags CppEnum
enum ErrorMsg
flagsName =
  let identifierWords :: [ErrorMsg]
identifierWords =
        ErrorMsg -> [ErrorMsg] -> [ErrorMsg]
forall a. a -> [a] -> [a]
replaceLast ErrorMsg
flagsName ([ErrorMsg] -> [ErrorMsg]) -> [ErrorMsg] -> [ErrorMsg]
forall a b. (a -> b) -> a -> b
$ (IdPart -> ErrorMsg) -> [IdPart] -> [ErrorMsg]
forall a b. (a -> b) -> [a] -> [b]
map IdPart -> ErrorMsg
idPartBase ([IdPart] -> [ErrorMsg]) -> [IdPart] -> [ErrorMsg]
forall a b. (a -> b) -> a -> b
$ Identifier -> [IdPart]
identifierParts (Identifier -> [IdPart]) -> Identifier -> [IdPart]
forall a b. (a -> b) -> a -> b
$ CppEnum -> Identifier
Enum.enumIdentifier CppEnum
enum
      identifier :: Identifier
identifier = [IdPart] -> Identifier
makeIdentifier ([IdPart] -> Identifier) -> [IdPart] -> Identifier
forall a b. (a -> b) -> a -> b
$ (ErrorMsg -> IdPart) -> [ErrorMsg] -> [IdPart]
forall a b. (a -> b) -> [a] -> [b]
map (\ErrorMsg
s -> ErrorMsg -> Maybe [Type] -> IdPart
makeIdPart ErrorMsg
s Maybe [Type]
forall a. Maybe a
Nothing) [ErrorMsg]
identifierWords
  in Flags
     { flagsExtName :: ExtName
flagsExtName = HasCallStack => ErrorMsg -> ExtName
ErrorMsg -> ExtName
toExtName (ErrorMsg -> ExtName) -> ErrorMsg -> ExtName
forall a b. (a -> b) -> a -> b
$ [ErrorMsg] -> ErrorMsg
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ErrorMsg]
identifierWords
     , flagsIdentifier :: Identifier
flagsIdentifier = Identifier
identifier
     , flagsEnum :: CppEnum
flagsEnum = CppEnum
enum
     , flagsReqs :: Reqs
flagsReqs = CppEnum -> Reqs
Enum.enumReqs CppEnum
enum  -- Copy reqs from the underlying enum.
     , flagsAddendum :: Addendum
flagsAddendum = Addendum
forall a. Monoid a => a
mempty
     }

flagsT :: Flags -> Type
flagsT :: Flags -> Type
flagsT = ConversionSpec -> Type
manualT (ConversionSpec -> Type)
-> (Flags -> ConversionSpec) -> Flags -> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Flags -> ConversionSpec
makeConversion

makeConversion :: Flags -> ConversionSpec
makeConversion :: Flags -> ConversionSpec
makeConversion Flags
flags =
  (ErrorMsg -> ConversionSpecCpp -> ConversionSpec
makeConversionSpec (Flags -> ErrorMsg
forall a. Show a => a -> ErrorMsg
show Flags
flags) ConversionSpecCpp
cpp)
  { conversionSpecHaskell = Just hs }
  where extName :: ExtName
extName = Flags -> ExtName
flagsExtName Flags
flags
        identifier :: Identifier
identifier = Flags -> Identifier
flagsIdentifier Flags
flags
        identifierStr :: ErrorMsg
identifierStr = Identifier -> ErrorMsg
LC.renderIdentifier Identifier
identifier
        enum :: CppEnum
enum = Flags -> CppEnum
flagsEnum Flags
flags

        cpp :: ConversionSpecCpp
cpp =
          (ErrorMsg -> Generator Reqs -> ConversionSpecCpp
makeConversionSpecCpp ErrorMsg
identifierStr (Reqs -> Generator Reqs
forall a. a -> ReaderT Env (WriterT [Chunk] (Either ErrorMsg)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Reqs -> Generator Reqs) -> Reqs -> Generator Reqs
forall a b. (a -> b) -> a -> b
$ CppEnum -> Reqs
Enum.enumReqs CppEnum
enum))
          { conversionSpecCppConversionType =
              Just . numType . evaluatedEnumNumericType <$>
              Enum.cppGetEvaluatedEnumData (Enum.enumExtName enum)

          , conversionSpecCppConversionToCppExpr = Just $ \Generator ()
fromVar Maybe (Generator ())
maybeToVar -> case Maybe (Generator ())
maybeToVar of
              Just Generator ()
toVar ->
                [ErrorMsg] -> Generator ()
forall (m :: * -> *). MonadWriter [Chunk] m => [ErrorMsg] -> m ()
LC.says [ErrorMsg
identifierStr, ErrorMsg
" "] Generator () -> Generator () -> Generator ()
forall a b.
ReaderT Env (WriterT [Chunk] (Either ErrorMsg)) a
-> ReaderT Env (WriterT [Chunk] (Either ErrorMsg)) b
-> ReaderT Env (WriterT [Chunk] (Either ErrorMsg)) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Generator ()
toVar Generator () -> Generator () -> Generator ()
forall a b.
ReaderT Env (WriterT [Chunk] (Either ErrorMsg)) a
-> ReaderT Env (WriterT [Chunk] (Either ErrorMsg)) b
-> ReaderT Env (WriterT [Chunk] (Either ErrorMsg)) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ErrorMsg -> Generator ()
forall (m :: * -> *). MonadWriter [Chunk] m => ErrorMsg -> m ()
LC.say ErrorMsg
"(" Generator () -> Generator () -> Generator ()
forall a b.
ReaderT Env (WriterT [Chunk] (Either ErrorMsg)) a
-> ReaderT Env (WriterT [Chunk] (Either ErrorMsg)) b
-> ReaderT Env (WriterT [Chunk] (Either ErrorMsg)) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Generator ()
fromVar Generator () -> Generator () -> Generator ()
forall a b.
ReaderT Env (WriterT [Chunk] (Either ErrorMsg)) a
-> ReaderT Env (WriterT [Chunk] (Either ErrorMsg)) b
-> ReaderT Env (WriterT [Chunk] (Either ErrorMsg)) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ErrorMsg -> Generator ()
forall (m :: * -> *). MonadWriter [Chunk] m => ErrorMsg -> m ()
LC.say ErrorMsg
");\n"
              Maybe (Generator ())
Nothing -> [ErrorMsg] -> Generator ()
forall (m :: * -> *). MonadWriter [Chunk] m => [ErrorMsg] -> m ()
LC.says [ErrorMsg
identifierStr, ErrorMsg
"("] Generator () -> Generator () -> Generator ()
forall a b.
ReaderT Env (WriterT [Chunk] (Either ErrorMsg)) a
-> ReaderT Env (WriterT [Chunk] (Either ErrorMsg)) b
-> ReaderT Env (WriterT [Chunk] (Either ErrorMsg)) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Generator ()
fromVar Generator () -> Generator () -> Generator ()
forall a b.
ReaderT Env (WriterT [Chunk] (Either ErrorMsg)) a
-> ReaderT Env (WriterT [Chunk] (Either ErrorMsg)) b
-> ReaderT Env (WriterT [Chunk] (Either ErrorMsg)) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ErrorMsg -> Generator ()
forall (m :: * -> *). MonadWriter [Chunk] m => ErrorMsg -> m ()
LC.say ErrorMsg
")"

          , conversionSpecCppConversionFromCppExpr = Just $ \Generator ()
fromVar Maybe (Generator ())
maybeToVar -> do
              Type
t <-
                NumericTypeInfo -> Type
numType (NumericTypeInfo -> Type)
-> (EvaluatedEnumData -> NumericTypeInfo)
-> EvaluatedEnumData
-> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EvaluatedEnumData -> NumericTypeInfo
evaluatedEnumNumericType (EvaluatedEnumData -> Type)
-> ReaderT
     Env (WriterT [Chunk] (Either ErrorMsg)) EvaluatedEnumData
-> ReaderT Env (WriterT [Chunk] (Either ErrorMsg)) Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                HasCallStack =>
ExtName
-> ReaderT
     Env (WriterT [Chunk] (Either ErrorMsg)) EvaluatedEnumData
ExtName
-> ReaderT
     Env (WriterT [Chunk] (Either ErrorMsg)) EvaluatedEnumData
Enum.cppGetEvaluatedEnumData (CppEnum -> ExtName
Enum.enumExtName CppEnum
enum)
              Maybe (Generator ())
-> (Generator () -> Generator ()) -> Generator ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (Generator ())
maybeToVar ((Generator () -> Generator ()) -> Generator ())
-> (Generator () -> Generator ()) -> Generator ()
forall a b. (a -> b) -> a -> b
$ \Generator ()
toVar -> do
                Maybe [ErrorMsg] -> Type -> Generator ()
forall (m :: * -> *).
MonadWriter [Chunk] m =>
Maybe [ErrorMsg] -> Type -> m ()
LC.sayType Maybe [ErrorMsg]
forall a. Maybe a
Nothing Type
t
                ErrorMsg -> Generator ()
forall (m :: * -> *). MonadWriter [Chunk] m => ErrorMsg -> m ()
LC.say ErrorMsg
" "
                Generator ()
toVar
                ErrorMsg -> Generator ()
forall (m :: * -> *). MonadWriter [Chunk] m => ErrorMsg -> m ()
LC.say ErrorMsg
" = "
              ErrorMsg -> Generator ()
forall (m :: * -> *). MonadWriter [Chunk] m => ErrorMsg -> m ()
LC.say ErrorMsg
"static_cast<"
              Maybe [ErrorMsg] -> Type -> Generator ()
forall (m :: * -> *).
MonadWriter [Chunk] m =>
Maybe [ErrorMsg] -> Type -> m ()
LC.sayType Maybe [ErrorMsg]
forall a. Maybe a
Nothing Type
t
              ErrorMsg -> Generator ()
forall (m :: * -> *). MonadWriter [Chunk] m => ErrorMsg -> m ()
LC.say ErrorMsg
">("
              Generator ()
fromVar
              ErrorMsg -> Generator ()
forall (m :: * -> *). MonadWriter [Chunk] m => ErrorMsg -> m ()
LC.say (ErrorMsg -> Generator ()) -> ErrorMsg -> Generator ()
forall a b. (a -> b) -> a -> b
$ case Maybe (Generator ())
maybeToVar of
                Just Generator ()
_ -> ErrorMsg
");\n"
                Maybe (Generator ())
Nothing -> ErrorMsg
")"
          }

        hs :: ConversionSpecHaskell
hs =
          (Generator HsType
-> Maybe (Generator HsType)
-> ConversionMethod (Generator ())
-> ConversionMethod (Generator ())
-> ConversionSpecHaskell
makeConversionSpecHaskell
             (HsQName -> HsType
HsTyCon (HsQName -> HsType) -> (ErrorMsg -> HsQName) -> ErrorMsg -> HsType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsName -> HsQName
UnQual (HsName -> HsQName) -> (ErrorMsg -> HsName) -> ErrorMsg -> HsQName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ErrorMsg -> HsName
HsIdent (ErrorMsg -> HsType)
-> ReaderT Env (WriterT Output (Except ErrorMsg)) ErrorMsg
-> Generator HsType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Constness
-> ExtName
-> ReaderT Env (WriterT Output (Except ErrorMsg)) ErrorMsg
LH.toHsTypeName Constness
Nonconst ExtName
extName)
             (Generator HsType -> Maybe (Generator HsType)
forall a. a -> Maybe a
Just (Generator HsType -> Maybe (Generator HsType))
-> Generator HsType -> Maybe (Generator HsType)
forall a b. (a -> b) -> a -> b
$ do EvaluatedEnumData
evaluatedData <- HasCallStack => ExtName -> Generator EvaluatedEnumData
ExtName -> Generator EvaluatedEnumData
Enum.hsGetEvaluatedEnumData (ExtName -> Generator EvaluatedEnumData)
-> ExtName -> Generator EvaluatedEnumData
forall a b. (a -> b) -> a -> b
$ CppEnum -> ExtName
Enum.enumExtName CppEnum
enum
                        HsTypeSide -> Type -> Generator HsType
LH.cppTypeToHsTypeAndUse HsTypeSide
LH.HsCSide (Type -> Generator HsType) -> Type -> Generator HsType
forall a b. (a -> b) -> a -> b
$
                          NumericTypeInfo -> Type
numType (NumericTypeInfo -> Type) -> NumericTypeInfo -> Type
forall a b. (a -> b) -> a -> b
$ EvaluatedEnumData -> NumericTypeInfo
evaluatedEnumNumericType EvaluatedEnumData
evaluatedData)
             (Generator () -> ConversionMethod (Generator ())
forall c. c -> ConversionMethod c
CustomConversion (Generator () -> ConversionMethod (Generator ()))
-> Generator () -> ConversionMethod (Generator ())
forall a b. (a -> b) -> a -> b
$ do
                HsImportSet -> Generator ()
LH.addImports (HsImportSet -> Generator ()) -> HsImportSet -> Generator ()
forall a b. (a -> b) -> a -> b
$ [HsImportSet] -> HsImportSet
forall a. Monoid a => [a] -> a
mconcat [ErrorMsg -> ErrorMsg -> HsImportSet
hsImport1 ErrorMsg
"Prelude" ErrorMsg
"(.)",
                                         HsImportSet
importForFlags,
                                         HsImportSet
importForPrelude]
                ErrorMsg
convertFn <- Flags -> ReaderT Env (WriterT Output (Except ErrorMsg)) ErrorMsg
toHsFlagsConvertFnName Flags
flags
                [ErrorMsg] -> Generator ()
LH.saysLn [ErrorMsg
"QtahP.return . QtahFlags.flagsToNum . ", ErrorMsg
convertFn])
             (Generator () -> ConversionMethod (Generator ())
forall c. c -> ConversionMethod c
CustomConversion (Generator () -> ConversionMethod (Generator ()))
-> Generator () -> ConversionMethod (Generator ())
forall a b. (a -> b) -> a -> b
$ do
                HsImportSet -> Generator ()
LH.addImports (HsImportSet -> Generator ()) -> HsImportSet -> Generator ()
forall a b. (a -> b) -> a -> b
$ [HsImportSet] -> HsImportSet
forall a. Monoid a => [a] -> a
mconcat [ErrorMsg -> ErrorMsg -> HsImportSet
hsImport1 ErrorMsg
"Prelude" ErrorMsg
"(.)",
                                         HsImportSet
importForFlags,
                                         HsImportSet
importForPrelude]
                ErrorMsg -> Generator ()
LH.sayLn ErrorMsg
"QtahP.return . QtahFlags.numToFlags"))
          { conversionSpecHaskellHsArgType = Just $ \HsName
typeVar -> do
              ErrorMsg
typeclassName <- Flags -> ReaderT Env (WriterT Output (Except ErrorMsg)) ErrorMsg
toHsFlagsTypeclassName Flags
flags
              HsQualType -> Generator HsQualType
forall a. a -> ReaderT Env (WriterT Output (Except ErrorMsg)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (HsQualType -> Generator HsQualType)
-> HsQualType -> Generator HsQualType
forall a b. (a -> b) -> a -> b
$
                HsContext -> HsType -> HsQualType
HsQualType [(HsName -> HsQName
UnQual (HsName -> HsQName) -> HsName -> HsQName
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> HsName
HsIdent ErrorMsg
typeclassName, [HsName -> HsType
HsTyVar HsName
typeVar])] (HsType -> HsQualType) -> HsType -> HsQualType
forall a b. (a -> b) -> a -> b
$
                HsName -> HsType
HsTyVar HsName
typeVar
          }

sayHsExport :: LH.SayExportMode -> Flags -> LH.Generator ()
sayHsExport :: SayExportMode -> Flags -> Generator ()
sayHsExport SayExportMode
mode Flags
flags =
  ErrorMsg -> Generator () -> Generator ()
forall a. ErrorMsg -> Generator a -> Generator a
LH.withErrorContext (ErrorMsg
"generating " ErrorMsg -> ShowS
forall a. [a] -> [a] -> [a]
++ Flags -> ErrorMsg
forall a. Show a => a -> ErrorMsg
show Flags
flags) (Generator () -> Generator ()) -> Generator () -> Generator ()
forall a b. (a -> b) -> a -> b
$ do

  -- Ensure that the flags is exported from the same module as its underlying
  -- enum.  We always want this to be the case.
  Generator ()
checkInFlagsEnumModule

  case SayExportMode
mode of
    SayExportMode
LH.SayExportForeignImports -> () -> Generator ()
forall a. a -> ReaderT Env (WriterT Output (Except ErrorMsg)) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

    SayExportMode
LH.SayExportDecls -> do
      ErrorMsg
typeName <- Flags -> ReaderT Env (WriterT Output (Except ErrorMsg)) ErrorMsg
toHsFlagsTypeName Flags
flags
      ErrorMsg
typeclassName <- Flags -> ReaderT Env (WriterT Output (Except ErrorMsg)) ErrorMsg
toHsFlagsTypeclassName Flags
flags
      ErrorMsg
convertFnName <- Flags -> ReaderT Env (WriterT Output (Except ErrorMsg)) ErrorMsg
toHsFlagsConvertFnName Flags
flags
      -- We'll use the type name as the data constructor name as well:
      let ctorName :: ErrorMsg
ctorName = ErrorMsg
typeName
          enum :: CppEnum
enum = Flags -> CppEnum
flagsEnum Flags
flags
      ErrorMsg
enumTypeName <- CppEnum -> ReaderT Env (WriterT Output (Except ErrorMsg)) ErrorMsg
Enum.toHsEnumTypeName CppEnum
enum
      EvaluatedEnumData
enumData <- HasCallStack => ExtName -> Generator EvaluatedEnumData
ExtName -> Generator EvaluatedEnumData
Enum.hsGetEvaluatedEnumData (ExtName -> Generator EvaluatedEnumData)
-> ExtName -> Generator EvaluatedEnumData
forall a b. (a -> b) -> a -> b
$ CppEnum -> ExtName
Enum.enumExtName CppEnum
enum
      HsType
numericType <-
        HsTypeSide -> Type -> Generator HsType
LH.cppTypeToHsTypeAndUse HsTypeSide
LH.HsCSide (Type -> Generator HsType) -> Type -> Generator HsType
forall a b. (a -> b) -> a -> b
$ NumericTypeInfo -> Type
numType (NumericTypeInfo -> Type) -> NumericTypeInfo -> Type
forall a b. (a -> b) -> a -> b
$ EvaluatedEnumData -> NumericTypeInfo
evaluatedEnumNumericType EvaluatedEnumData
enumData
      let numericTypeStr :: ErrorMsg
numericTypeStr = HsType -> ErrorMsg
forall a. Pretty a => a -> ErrorMsg
LH.prettyPrint HsType
numericType

      -- Emit the newtype wrapper.
      ErrorMsg -> Generator ()
LH.addExport ErrorMsg
typeName
      HsImportSet -> Generator ()
LH.addImports (HsImportSet -> Generator ()) -> HsImportSet -> Generator ()
forall a b. (a -> b) -> a -> b
$ [HsImportSet] -> HsImportSet
forall a. Monoid a => [a] -> a
mconcat [ErrorMsg -> [ErrorMsg] -> HsImportSet
hsImports ErrorMsg
"Prelude" [ErrorMsg
"($)", ErrorMsg
"(.)"],
                               ErrorMsg -> [ErrorMsg] -> HsImportSet
hsImports ErrorMsg
"Data.Bits" [ErrorMsg
"(.&.)", ErrorMsg
"(.|.)"],
                               HsImportSet
importForBits,
                               HsImportSet
importForFlags,
                               HsImportSet
importForPrelude,
                               HsImportSet
importForRuntime]
      Generator ()
LH.ln
      [ErrorMsg] -> Generator ()
LH.saysLn [ErrorMsg
"newtype ", ErrorMsg
typeName, ErrorMsg
" = ", ErrorMsg
ctorName, ErrorMsg
" (", ErrorMsg
numericTypeStr,
                 ErrorMsg
") deriving (QtahP.Eq, QtahP.Ord, QtahP.Show)"]

      -- Emit the Flags instance.
      Generator ()
LH.ln
      [ErrorMsg] -> Generator ()
LH.saysLn [ErrorMsg
"instance QtahFlags.Flags (", ErrorMsg
numericTypeStr, ErrorMsg
") ",
                 ErrorMsg
enumTypeName, ErrorMsg
" ", ErrorMsg
typeName, ErrorMsg
" where"]
      Generator () -> Generator ()
forall a. Generator a -> Generator a
LH.indent (Generator () -> Generator ()) -> Generator () -> Generator ()
forall a b. (a -> b) -> a -> b
$ do
        [ErrorMsg] -> Generator ()
LH.saysLn [ErrorMsg
"enumToFlags = ", ErrorMsg
ctorName, ErrorMsg
" . QtahFHR.fromCppEnum"]
        [ErrorMsg] -> Generator ()
LH.saysLn [ErrorMsg
"flagsToEnum (", ErrorMsg
ctorName, ErrorMsg
" x') = QtahFHR.toCppEnum x'"]

      -- Emit an IsXXX typeclass with a method to convert arguments to flag
      -- values.
      ErrorMsg -> Generator ()
LH.addExport' ErrorMsg
typeclassName
      Generator ()
LH.ln
      [ErrorMsg] -> Generator ()
LH.saysLn [ErrorMsg
"class ", ErrorMsg
typeclassName, ErrorMsg
" a where"]
      Generator () -> Generator ()
forall a. Generator a -> Generator a
LH.indent (Generator () -> Generator ()) -> Generator () -> Generator ()
forall a b. (a -> b) -> a -> b
$ do
        [ErrorMsg] -> Generator ()
LH.saysLn [ErrorMsg
convertFnName, ErrorMsg
" :: a -> ", ErrorMsg
typeName]

      -- Emit IsXXX instances for the flags, enum, and numeric types.
      Generator ()
LH.ln
      [ErrorMsg] -> Generator ()
LH.saysLn [ErrorMsg
"instance ", ErrorMsg
typeclassName, ErrorMsg
" ", ErrorMsg
typeName,
                 ErrorMsg
" where ", ErrorMsg
convertFnName, ErrorMsg
" = QtahP.id"]
      [ErrorMsg] -> Generator ()
LH.saysLn [ErrorMsg
"instance ", ErrorMsg
typeclassName, ErrorMsg
" ", ErrorMsg
enumTypeName,
                 ErrorMsg
" where ", ErrorMsg
convertFnName, ErrorMsg
" = QtahFlags.enumToFlags"]
      [ErrorMsg] -> Generator ()
LH.saysLn [ErrorMsg
"instance ", ErrorMsg
typeclassName, ErrorMsg
" (", ErrorMsg
numericTypeStr,
                 ErrorMsg
") where ", ErrorMsg
convertFnName, ErrorMsg
" = QtahFlags.numToFlags"]

      -- Emit Haskell bindings for flags entries.
      [([ErrorMsg], Integer)]
-> (([ErrorMsg], Integer) -> Generator ()) -> Generator ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Map [ErrorMsg] Integer -> [([ErrorMsg], Integer)]
forall k a. Map k a -> [(k, a)]
M.toList (Map [ErrorMsg] Integer -> [([ErrorMsg], Integer)])
-> Map [ErrorMsg] Integer -> [([ErrorMsg], Integer)]
forall a b. (a -> b) -> a -> b
$ EvaluatedEnumData -> Map [ErrorMsg] Integer
evaluatedEnumValueMap EvaluatedEnumData
enumData) ((([ErrorMsg], Integer) -> Generator ()) -> Generator ())
-> (([ErrorMsg], Integer) -> Generator ()) -> Generator ()
forall a b. (a -> b) -> a -> b
$ \([ErrorMsg]
words, Integer
num) -> do
        let words' :: [ErrorMsg]
words' = ForeignLanguage -> CppEnum -> [ErrorMsg] -> [ErrorMsg]
Enum.enumGetOverriddenEntryName ForeignLanguage
Haskell CppEnum
enum [ErrorMsg]
words
        ErrorMsg
bindingName <- Flags
-> [ErrorMsg]
-> ReaderT Env (WriterT Output (Except ErrorMsg)) ErrorMsg
toHsFlagsBindingName Flags
flags [ErrorMsg]
words'
        ErrorMsg -> Generator ()
LH.addExport ErrorMsg
bindingName
        Generator ()
LH.ln
        [ErrorMsg] -> Generator ()
LH.saysLn [ErrorMsg
bindingName, ErrorMsg
" :: ", ErrorMsg
typeName]
        [ErrorMsg] -> Generator ()
LH.saysLn [ErrorMsg
bindingName, ErrorMsg
" = ", ErrorMsg
ctorName, ErrorMsg
" (", Integer -> ErrorMsg
forall a. Show a => a -> ErrorMsg
show Integer
num, ErrorMsg
")"]

      -- Emit the Bits instance.  This code is the same as what Hoppy uses to
      -- emit enum Bits instances.
      Generator ()
LH.ln
      [ErrorMsg] -> Generator ()
LH.saysLn [ErrorMsg
"instance QtahDB.Bits ", ErrorMsg
typeName, ErrorMsg
" where"]
      Generator () -> Generator ()
forall a. Generator a -> Generator a
LH.indent (Generator () -> Generator ()) -> Generator () -> Generator ()
forall a b. (a -> b) -> a -> b
$ do
        let fun1 :: ErrorMsg -> Generator ()
fun1 ErrorMsg
f =
              [ErrorMsg] -> Generator ()
LH.saysLn [ErrorMsg
f, ErrorMsg
" x = QtahFlags.numToFlags $ QtahDB.",
                         ErrorMsg
f, ErrorMsg
" $ QtahFlags.flagsToNum x"]
            fun1Int :: ErrorMsg -> Generator ()
fun1Int ErrorMsg
f =
              [ErrorMsg] -> Generator ()
LH.saysLn [ErrorMsg
f, ErrorMsg
" x i = QtahFlags.numToFlags $ QtahDB.",
                         ErrorMsg
f, ErrorMsg
" (QtahFlags.flagsToNum x) i"]
            fun2 :: ErrorMsg -> Generator ()
fun2 ErrorMsg
f =
              [ErrorMsg] -> Generator ()
LH.saysLn [ErrorMsg
f, ErrorMsg
" x y = QtahFlags.numToFlags $ QtahDB.",
                         ErrorMsg
f, ErrorMsg
" (QtahFlags.flagsToNum x) (QtahFlags.flagsToNum y)"]
            op2 :: ErrorMsg -> Generator ()
op2 ErrorMsg
op =
              [ErrorMsg] -> Generator ()
LH.saysLn [ErrorMsg
"x ", ErrorMsg
op, ErrorMsg
" y = QtahFlags.numToFlags ",
                         ErrorMsg
"(QtahFlags.flagsToNum x ", ErrorMsg
op, ErrorMsg
" QtahFlags.flagsToNum y)"]
        ErrorMsg -> Generator ()
op2 ErrorMsg
".&."
        ErrorMsg -> Generator ()
op2 ErrorMsg
".|."
        ErrorMsg -> Generator ()
fun2 ErrorMsg
"xor"
        ErrorMsg -> Generator ()
fun1 ErrorMsg
"complement"
        ErrorMsg -> Generator ()
fun1Int ErrorMsg
"shift"
        ErrorMsg -> Generator ()
fun1Int ErrorMsg
"rotate"
        ErrorMsg -> Generator ()
LH.sayLn ErrorMsg
"bitSize x = case QtahDB.bitSizeMaybe x of"
        Generator () -> Generator ()
forall a. Generator a -> Generator a
LH.indent (Generator () -> Generator ()) -> Generator () -> Generator ()
forall a b. (a -> b) -> a -> b
$ do
          ErrorMsg -> Generator ()
LH.sayLn ErrorMsg
"  QtahP.Just n -> n"
          -- Same error message as the prelude here:
          ErrorMsg -> Generator ()
LH.sayLn ErrorMsg
"  QtahP.Nothing -> QtahP.error \"bitSize is undefined\""
        ErrorMsg -> Generator ()
LH.sayLn ErrorMsg
"bitSizeMaybe = QtahDB.bitSizeMaybe . QtahFlags.flagsToNum"
        ErrorMsg -> Generator ()
LH.sayLn ErrorMsg
"isSigned = QtahDB.isSigned . QtahFlags.flagsToNum"
        ErrorMsg -> Generator ()
LH.sayLn ErrorMsg
"testBit x i = QtahDB.testBit (QtahFlags.flagsToNum x) i"
        ErrorMsg -> Generator ()
LH.sayLn ErrorMsg
"bit = QtahFlags.numToFlags . QtahDB.bit"
        ErrorMsg -> Generator ()
LH.sayLn ErrorMsg
"popCount = QtahDB.popCount . QtahFlags.flagsToNum"

    SayExportMode
LH.SayExportBoot -> do
      -- Emit a minimal version of the regular binding code.
      ErrorMsg
typeName <- Flags -> ReaderT Env (WriterT Output (Except ErrorMsg)) ErrorMsg
toHsFlagsTypeName Flags
flags
      ErrorMsg
typeclassName <- Flags -> ReaderT Env (WriterT Output (Except ErrorMsg)) ErrorMsg
toHsFlagsTypeclassName Flags
flags
      ErrorMsg
convertFnName <- Flags -> ReaderT Env (WriterT Output (Except ErrorMsg)) ErrorMsg
toHsFlagsConvertFnName Flags
flags
      -- We'll use the type name as the data constructor name as well:
      let ctorName :: ErrorMsg
ctorName = ErrorMsg
typeName
          enum :: CppEnum
enum = Flags -> CppEnum
flagsEnum Flags
flags
      ErrorMsg
enumTypeName <- CppEnum -> ReaderT Env (WriterT Output (Except ErrorMsg)) ErrorMsg
Enum.toHsEnumTypeName CppEnum
enum
      EvaluatedEnumData
enumData <- HasCallStack => ExtName -> Generator EvaluatedEnumData
ExtName -> Generator EvaluatedEnumData
Enum.hsGetEvaluatedEnumData (ExtName -> Generator EvaluatedEnumData)
-> ExtName -> Generator EvaluatedEnumData
forall a b. (a -> b) -> a -> b
$ CppEnum -> ExtName
Enum.enumExtName CppEnum
enum
      HsType
numericType <-
        HsTypeSide -> Type -> Generator HsType
LH.cppTypeToHsTypeAndUse HsTypeSide
LH.HsCSide (Type -> Generator HsType) -> Type -> Generator HsType
forall a b. (a -> b) -> a -> b
$ NumericTypeInfo -> Type
numType (NumericTypeInfo -> Type) -> NumericTypeInfo -> Type
forall a b. (a -> b) -> a -> b
$ EvaluatedEnumData -> NumericTypeInfo
evaluatedEnumNumericType EvaluatedEnumData
enumData
      let numericTypeStr :: ErrorMsg
numericTypeStr = HsType -> ErrorMsg
forall a. Pretty a => a -> ErrorMsg
LH.prettyPrint HsType
numericType

      HsImportSet -> Generator ()
LH.addImports (HsImportSet -> Generator ()) -> HsImportSet -> Generator ()
forall a b. (a -> b) -> a -> b
$ [HsImportSet] -> HsImportSet
forall a. Monoid a => [a] -> a
mconcat [HsImportSet
importForBits, HsImportSet
importForFlags, HsImportSet
importForPrelude]
      Generator ()
LH.ln
      ErrorMsg -> Generator ()
LH.addExport ErrorMsg
typeName
      [ErrorMsg] -> Generator ()
LH.saysLn [ErrorMsg
"newtype ", ErrorMsg
typeName, ErrorMsg
" = ", ErrorMsg
ctorName, ErrorMsg
" (", ErrorMsg
numericTypeStr, ErrorMsg
")"]
      [ErrorMsg] -> Generator ()
LH.saysLn [ErrorMsg
"instance QtahDB.Bits ", ErrorMsg
typeName]
      [ErrorMsg] -> Generator ()
LH.saysLn [ErrorMsg
"instance QtahP.Eq ", ErrorMsg
typeName]
      [ErrorMsg] -> Generator ()
LH.saysLn [ErrorMsg
"instance QtahP.Ord ", ErrorMsg
typeName]
      [ErrorMsg] -> Generator ()
LH.saysLn [ErrorMsg
"instance QtahP.Show ", ErrorMsg
typeName]
      Generator ()
LH.ln
      [ErrorMsg] -> Generator ()
LH.saysLn [ErrorMsg
"instance QtahFlags.Flags (", ErrorMsg
numericTypeStr, ErrorMsg
") ", ErrorMsg
enumTypeName, ErrorMsg
" ", ErrorMsg
typeName]
      Generator ()
LH.ln
      ErrorMsg -> Generator ()
LH.addExport' ErrorMsg
typeclassName
      [ErrorMsg] -> Generator ()
LH.saysLn [ErrorMsg
"class ", ErrorMsg
typeclassName, ErrorMsg
" a where"]
      Generator () -> Generator ()
forall a. Generator a -> Generator a
LH.indent (Generator () -> Generator ()) -> Generator () -> Generator ()
forall a b. (a -> b) -> a -> b
$ do
        [ErrorMsg] -> Generator ()
LH.saysLn [ErrorMsg
convertFnName, ErrorMsg
" :: a -> ", ErrorMsg
typeName]
      Generator ()
LH.ln
      [ErrorMsg] -> Generator ()
LH.saysLn [ErrorMsg
"instance ", ErrorMsg
typeclassName, ErrorMsg
" ", ErrorMsg
typeName]
      [ErrorMsg] -> Generator ()
LH.saysLn [ErrorMsg
"instance ", ErrorMsg
typeclassName, ErrorMsg
" ", ErrorMsg
enumTypeName]
      [ErrorMsg] -> Generator ()
LH.saysLn [ErrorMsg
"instance ", ErrorMsg
typeclassName, ErrorMsg
" ", ErrorMsg
numericTypeStr]
      Generator ()
LH.ln
      [([ErrorMsg], Integer)]
-> (([ErrorMsg], Integer) -> Generator ()) -> Generator ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Map [ErrorMsg] Integer -> [([ErrorMsg], Integer)]
forall k a. Map k a -> [(k, a)]
M.toList (Map [ErrorMsg] Integer -> [([ErrorMsg], Integer)])
-> Map [ErrorMsg] Integer -> [([ErrorMsg], Integer)]
forall a b. (a -> b) -> a -> b
$ EvaluatedEnumData -> Map [ErrorMsg] Integer
evaluatedEnumValueMap EvaluatedEnumData
enumData) ((([ErrorMsg], Integer) -> Generator ()) -> Generator ())
-> (([ErrorMsg], Integer) -> Generator ()) -> Generator ()
forall a b. (a -> b) -> a -> b
$ \([ErrorMsg]
words, Integer
_) -> do
        let words' :: [ErrorMsg]
words' = ForeignLanguage -> CppEnum -> [ErrorMsg] -> [ErrorMsg]
Enum.enumGetOverriddenEntryName ForeignLanguage
Haskell CppEnum
enum [ErrorMsg]
words
        ErrorMsg
bindingName <- Flags
-> [ErrorMsg]
-> ReaderT Env (WriterT Output (Except ErrorMsg)) ErrorMsg
toHsFlagsBindingName Flags
flags [ErrorMsg]
words'
        ErrorMsg -> Generator ()
LH.addExport ErrorMsg
bindingName
        [ErrorMsg] -> Generator ()
LH.saysLn [ErrorMsg
bindingName, ErrorMsg
" :: ", ErrorMsg
typeName]

    where checkInFlagsEnumModule :: Generator ()
checkInFlagsEnumModule = do
            Module
currentModule <- Generator Module
LH.askModule
            Module
enumModule <- ExtName -> Generator Module
LH.getExtNameModule (ExtName -> Generator Module) -> ExtName -> Generator Module
forall a b. (a -> b) -> a -> b
$ CppEnum -> ExtName
Enum.enumExtName (CppEnum -> ExtName) -> CppEnum -> ExtName
forall a b. (a -> b) -> a -> b
$ Flags -> CppEnum
flagsEnum Flags
flags
            Bool -> Generator () -> Generator ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Module
currentModule Module -> Module -> Bool
forall a. Eq a => a -> a -> Bool
/= Module
enumModule) (Generator () -> Generator ()) -> Generator () -> Generator ()
forall a b. (a -> b) -> a -> b
$
              ErrorMsg -> Generator ()
forall a.
ErrorMsg -> ReaderT Env (WriterT Output (Except ErrorMsg)) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ErrorMsg -> Generator ()) -> ErrorMsg -> Generator ()
forall a b. (a -> b) -> a -> b
$ Flags -> ErrorMsg
forall a. Show a => a -> ErrorMsg
show Flags
flags ErrorMsg -> ShowS
forall a. [a] -> [a] -> [a]
++ ErrorMsg
" and " ErrorMsg -> ShowS
forall a. [a] -> [a] -> [a]
++ CppEnum -> ErrorMsg
forall a. Show a => a -> ErrorMsg
show (Flags -> CppEnum
flagsEnum Flags
flags) ErrorMsg -> ShowS
forall a. [a] -> [a] -> [a]
++
              ErrorMsg
"are not exported from the same module."

-- | Imports and returns the Haskell type name for a 'Flags'.
toHsFlagsTypeName :: Flags -> LH.Generator String
toHsFlagsTypeName :: Flags -> ReaderT Env (WriterT Output (Except ErrorMsg)) ErrorMsg
toHsFlagsTypeName Flags
flags =
  ErrorMsg
-> ReaderT Env (WriterT Output (Except ErrorMsg)) ErrorMsg
-> ReaderT Env (WriterT Output (Except ErrorMsg)) ErrorMsg
forall a. ErrorMsg -> Generator a -> Generator a
LH.inFunction ErrorMsg
"toHsFlagsTypeName" (ReaderT Env (WriterT Output (Except ErrorMsg)) ErrorMsg
 -> ReaderT Env (WriterT Output (Except ErrorMsg)) ErrorMsg)
-> ReaderT Env (WriterT Output (Except ErrorMsg)) ErrorMsg
-> ReaderT Env (WriterT Output (Except ErrorMsg)) ErrorMsg
forall a b. (a -> b) -> a -> b
$
  ExtName
-> ErrorMsg
-> ReaderT Env (WriterT Output (Except ErrorMsg)) ErrorMsg
LH.addExtNameModule (Flags -> ExtName
flagsExtName Flags
flags) (ErrorMsg
 -> ReaderT Env (WriterT Output (Except ErrorMsg)) ErrorMsg)
-> ErrorMsg
-> ReaderT Env (WriterT Output (Except ErrorMsg)) ErrorMsg
forall a b. (a -> b) -> a -> b
$ Flags -> ErrorMsg
toHsFlagsTypeName' Flags
flags

-- | Pure version of 'toHsTypeName' that doesn't create a qualified name.
toHsFlagsTypeName' :: Flags -> String
toHsFlagsTypeName' :: Flags -> ErrorMsg
toHsFlagsTypeName' = Constness -> ExtName -> ErrorMsg
LH.toHsTypeName' Constness
Nonconst (ExtName -> ErrorMsg) -> (Flags -> ExtName) -> Flags -> ErrorMsg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Flags -> ExtName
flagsExtName

-- | Imports and returns the Haskell \"IsFooFlags\" typeclass for a 'Flags'.
toHsFlagsTypeclassName :: Flags -> LH.Generator String
toHsFlagsTypeclassName :: Flags -> ReaderT Env (WriterT Output (Except ErrorMsg)) ErrorMsg
toHsFlagsTypeclassName Flags
flags =
  ErrorMsg
-> ReaderT Env (WriterT Output (Except ErrorMsg)) ErrorMsg
-> ReaderT Env (WriterT Output (Except ErrorMsg)) ErrorMsg
forall a. ErrorMsg -> Generator a -> Generator a
LH.inFunction ErrorMsg
"toHsFlagsTypeclassName" (ReaderT Env (WriterT Output (Except ErrorMsg)) ErrorMsg
 -> ReaderT Env (WriterT Output (Except ErrorMsg)) ErrorMsg)
-> ReaderT Env (WriterT Output (Except ErrorMsg)) ErrorMsg
-> ReaderT Env (WriterT Output (Except ErrorMsg)) ErrorMsg
forall a b. (a -> b) -> a -> b
$
  ExtName
-> ErrorMsg
-> ReaderT Env (WriterT Output (Except ErrorMsg)) ErrorMsg
LH.addExtNameModule (Flags -> ExtName
flagsExtName Flags
flags) (ErrorMsg
 -> ReaderT Env (WriterT Output (Except ErrorMsg)) ErrorMsg)
-> ErrorMsg
-> ReaderT Env (WriterT Output (Except ErrorMsg)) ErrorMsg
forall a b. (a -> b) -> a -> b
$ Flags -> ErrorMsg
toHsFlagsTypeclassName' Flags
flags

-- | Pure version of 'toHsFlagsTypeclassName' that doesn't create a qualified
-- name.
toHsFlagsTypeclassName' :: Flags -> String
toHsFlagsTypeclassName' :: Flags -> ErrorMsg
toHsFlagsTypeclassName' Flags
flags = Char
'I'Char -> ShowS
forall a. a -> [a] -> [a]
:Char
's'Char -> ShowS
forall a. a -> [a] -> [a]
:Flags -> ErrorMsg
toHsFlagsTypeName' Flags
flags

-- | Imports and returns the Haskell \"toFooFlags\" typeclass method for a
-- 'Flags', in the typeclass named with 'toHsFlagsTypeclassName'.
toHsFlagsConvertFnName :: Flags -> LH.Generator String
toHsFlagsConvertFnName :: Flags -> ReaderT Env (WriterT Output (Except ErrorMsg)) ErrorMsg
toHsFlagsConvertFnName Flags
flags =
  ErrorMsg
-> ReaderT Env (WriterT Output (Except ErrorMsg)) ErrorMsg
-> ReaderT Env (WriterT Output (Except ErrorMsg)) ErrorMsg
forall a. ErrorMsg -> Generator a -> Generator a
LH.inFunction ErrorMsg
"toHsFlagsConvertFnName" (ReaderT Env (WriterT Output (Except ErrorMsg)) ErrorMsg
 -> ReaderT Env (WriterT Output (Except ErrorMsg)) ErrorMsg)
-> ReaderT Env (WriterT Output (Except ErrorMsg)) ErrorMsg
-> ReaderT Env (WriterT Output (Except ErrorMsg)) ErrorMsg
forall a b. (a -> b) -> a -> b
$
  ExtName
-> ErrorMsg
-> ReaderT Env (WriterT Output (Except ErrorMsg)) ErrorMsg
LH.addExtNameModule (Flags -> ExtName
flagsExtName Flags
flags) (ErrorMsg
 -> ReaderT Env (WriterT Output (Except ErrorMsg)) ErrorMsg)
-> ErrorMsg
-> ReaderT Env (WriterT Output (Except ErrorMsg)) ErrorMsg
forall a b. (a -> b) -> a -> b
$ Flags -> ErrorMsg
toHsFlagsConvertFnName' Flags
flags

-- | Pure version of 'toHsFlagsConvertFnName' that doesn't create a qualified
-- name.
toHsFlagsConvertFnName' :: Flags -> String
toHsFlagsConvertFnName' :: Flags -> ErrorMsg
toHsFlagsConvertFnName' Flags
flags = Char
't'Char -> ShowS
forall a. a -> [a] -> [a]
:Char
'o'Char -> ShowS
forall a. a -> [a] -> [a]
:Flags -> ErrorMsg
toHsFlagsTypeName' Flags
flags

-- | Constructs the name of the binding for a specific flags entry.
--
-- This is the equivalent enum data constructor name, converted to a valid
-- binding name by lower-casing the first letter.
toHsFlagsBindingName :: Flags -> [String] -> LH.Generator String
toHsFlagsBindingName :: Flags
-> [ErrorMsg]
-> ReaderT Env (WriterT Output (Except ErrorMsg)) ErrorMsg
toHsFlagsBindingName Flags
flags [ErrorMsg]
words =
  ErrorMsg
-> ReaderT Env (WriterT Output (Except ErrorMsg)) ErrorMsg
-> ReaderT Env (WriterT Output (Except ErrorMsg)) ErrorMsg
forall a. ErrorMsg -> Generator a -> Generator a
LH.inFunction ErrorMsg
"toHsFlagsBindingName" (ReaderT Env (WriterT Output (Except ErrorMsg)) ErrorMsg
 -> ReaderT Env (WriterT Output (Except ErrorMsg)) ErrorMsg)
-> ReaderT Env (WriterT Output (Except ErrorMsg)) ErrorMsg
-> ReaderT Env (WriterT Output (Except ErrorMsg)) ErrorMsg
forall a b. (a -> b) -> a -> b
$
  ExtName
-> ErrorMsg
-> ReaderT Env (WriterT Output (Except ErrorMsg)) ErrorMsg
LH.addExtNameModule (Flags -> ExtName
flagsExtName Flags
flags) (ErrorMsg
 -> ReaderT Env (WriterT Output (Except ErrorMsg)) ErrorMsg)
-> ErrorMsg
-> ReaderT Env (WriterT Output (Except ErrorMsg)) ErrorMsg
forall a b. (a -> b) -> a -> b
$ Flags -> [ErrorMsg] -> ErrorMsg
toHsFlagsBindingName' Flags
flags [ErrorMsg]
words

-- | Pure version of 'toHsFlagsBindingName' that doesn't create a qualified
-- name.
toHsFlagsBindingName' :: Flags -> [String] -> String
toHsFlagsBindingName' :: Flags -> [ErrorMsg] -> ErrorMsg
toHsFlagsBindingName' Flags
flags [ErrorMsg]
words =
  ShowS
lowerFirst ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ CppEnum -> [ErrorMsg] -> ErrorMsg
Enum.toHsEnumCtorName' (Flags -> CppEnum
flagsEnum Flags
flags) [ErrorMsg]
words