module Barbies.TH.Config
  ( DeclareBareBConfig(..)
  , classic
  , passthrough
  ) where
import Language.Haskell.TH

-- | Keep it in a separate module until NoFieldSelectors gets widespread
data DeclareBareBConfig = DeclareBareBConfig
  { DeclareBareBConfig -> [Name]
friends :: [Name] -- ^ Members with these types won't be wrapped with 'Wear'
  , DeclareBareBConfig -> String -> Maybe String
bareName :: String -> Maybe String
  -- ^ generate a type synonym for the 'Barbies.Bare.Bare' type?
  , DeclareBareBConfig -> String -> Maybe String
coveredName :: String -> Maybe String
  -- ^ generate a type synonym for the 'Barbies.Bare.Covered' type?
  , DeclareBareBConfig -> String -> String
barbieName :: String -> String
  -- ^ modify the name of the datatype
  , DeclareBareBConfig -> Q Name
switchName :: Q Name
  -- ^ the name of the type parameter to toggle between Bare and covered
  , DeclareBareBConfig -> Q Name
wrapperName :: Q Name
  -- ^ the name of the type parameter of the wrapper for each field
  }

-- | Does not define any type synonyms
classic :: DeclareBareBConfig
classic :: DeclareBareBConfig
classic = DeclareBareBConfig
  { friends :: [Name]
friends = []
  , bareName :: String -> Maybe String
bareName = forall a b. a -> b -> a
const forall a. Maybe a
Nothing
  , coveredName :: String -> Maybe String
coveredName = forall a b. a -> b -> a
const forall a. Maybe a
Nothing
  , barbieName :: String -> String
barbieName = forall a. a -> a
id
  , switchName :: Q Name
switchName = forall (m :: * -> *). Quote m => String -> m Name
newName String
"sw"
  , wrapperName :: Q Name
wrapperName = forall (m :: * -> *). Quote m => String -> m Name
newName String
"h"
  }

-- | Defines a synonym for the bare type with the same name.
-- The strippable definition is suffixed by B, and the covered type is suffixed by H.
passthrough :: DeclareBareBConfig
passthrough :: DeclareBareBConfig
passthrough = DeclareBareBConfig
  { friends :: [Name]
friends = []
  , bareName :: String -> Maybe String
bareName = forall a. a -> Maybe a
Just
  , coveredName :: String -> Maybe String
coveredName = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. [a] -> [a] -> [a]
++String
"H")
  , barbieName :: String -> String
barbieName = (forall a. [a] -> [a] -> [a]
++String
"B")
  , switchName :: Q Name
switchName = forall (m :: * -> *). Quote m => String -> m Name
newName String
"sw"
  , wrapperName :: Q Name
wrapperName = forall (m :: * -> *). Quote m => String -> m Name
newName String
"h"
  }