module GI.Attributes ( genAttributes , genAllAttributes ) where #if !MIN_VERSION_base(4,8,0) import Control.Applicative ((<$>)) #endif import Control.Monad (forM_, when) import Control.Monad.Writer (tell) import qualified Data.Set as S import qualified Data.Text as T import Data.Text (Text) import GI.API import GI.Code import GI.SymbolNaming import GI.Properties import GI.CodeGen (genPrelude) -- A list of distinct property names for all GObjects appearing in the -- given list of APIs. findObjectPropNames :: [(Name, API)] -> CodeGen [Text] findObjectPropNames apis = S.toList <$> go apis S.empty where go :: [(Name, API)] -> S.Set Text -> CodeGen (S.Set Text) go [] set = return set go ((_, api):apis) set = case api of APIInterface iface -> go apis $ insertProps (ifProperties iface) set APIObject object -> go apis $ insertProps (objProperties object) set _ -> go apis set insertProps :: [Property] -> S.Set Text -> S.Set Text insertProps props set = S.union set ((S.fromList . map propName) props) genPropertyAttr :: Text -> CodeGen () genPropertyAttr pName = group $ do line $ "-- Property \"" ++ T.unpack pName ++ "\"" let name = (hyphensToCamelCase . T.unpack) pName line $ "_" ++ lcFirst name ++ " :: Proxy \"" ++ T.unpack pName ++ "\"" line $ "_" ++ lcFirst name ++ " = Proxy" genAllAttributes :: [(Name, API)] -> String -> CodeGen () genAllAttributes allAPIs modulePrefix = do line "-- Generated code." blank line "{-# LANGUAGE DataKinds #-}" blank line $ "module " ++ modulePrefix ++ "Properties where" blank line $ "import Data.Proxy (Proxy(..))" blank propNames <- findObjectPropNames allAPIs forM_ propNames $ \name -> do genPropertyAttr name blank genProps :: (Name, API) -> CodeGen () genProps (n, APIObject o) = genObjectProperties n o genProps (n, APIInterface i) = genInterfaceProperties n i genProps _ = return () genAttributes :: String -> [(Name, API)] -> String -> CodeGen () genAttributes name apis modulePrefix = do let mp = (modulePrefix ++) nm = ucFirst name code <- recurse' $ forM_ apis genProps -- Providing orphan instances is the whole point of these modules, -- tell GHC that this is fine. line "{-# OPTIONS_GHC -fno-warn-orphans -fno-warn-unused-imports #-}" blank genPrelude (nm ++ "Attributes") modulePrefix deps <- getDeps forM_ (S.toList deps) $ \i -> when (i /= name) $ do line $ "import qualified " ++ mp (ucFirst i) ++ " as " ++ ucFirst i line $ "import qualified " ++ mp (ucFirst i) ++ "Attributes as " ++ ucFirst i ++ "A" line $ "import " ++ modulePrefix ++ nm blank tell code