module Data.ProtoLens.Compiler.Plugin
( ProtoFileName
, ProtoFile(..)
, analyzeProtoFiles
, collectEnvFromDeps
, outputFilePath
, moduleName
, moduleNameStr
) where
import Data.Char (toUpper)
import Data.List (foldl', intercalate)
import qualified Data.Map.Strict as Map
import Data.Map.Strict (Map, unions, (!))
import Data.Monoid ((<>))
import Data.String (fromString)
import qualified Data.Text as T
import Data.Text (Text)
import Lens.Family2
import Proto.Google.Protobuf.Descriptor
(FileDescriptorProto, name, dependency, publicDependency)
import System.FilePath (dropExtension, splitDirectories)
import Data.ProtoLens.Compiler.Definitions
import Data.ProtoLens.Compiler.Combinators (ModuleName, Name, QName)
type ProtoFileName = Text
data ProtoFile = ProtoFile
{ descriptor :: FileDescriptorProto
, haskellModule :: ModuleName
, definitions :: Env Name
, exports :: [ProtoFileName]
, exportedEnv :: Env QName
}
analyzeProtoFiles :: Text -> [FileDescriptorProto] -> Map ProtoFileName ProtoFile
analyzeProtoFiles modulePrefix files =
Map.fromList [ (f ^. name, ingestFile f) | f <- files ]
where
filesByName = Map.fromList [(f ^. name, f) | f <- files]
moduleNames = fmap (moduleName modulePrefix) filesByName
definitionsByName = fmap collectDefinitions filesByName
exportsByName = transitiveExports files
localExports = Map.intersectionWith qualifyEnv moduleNames definitionsByName
exportedEnvs = fmap (\es -> unions [localExports ! e | e <- es]) exportsByName
ingestFile f = ProtoFile
{ descriptor = f
, haskellModule = moduleNames ! n
, definitions = definitionsByName ! n
, exports = exportsByName ! n
, exportedEnv = exportedEnvs ! n
}
where
n = f ^. name
collectEnvFromDeps :: [ProtoFileName] -> Map ProtoFileName ProtoFile -> Env QName
collectEnvFromDeps deps filesByName =
unions $ fmap (exportedEnv . (filesByName !)) deps
outputFilePath :: String -> Text
outputFilePath n = T.replace "." "/" (T.pack n) <> ".hs"
moduleName :: Text -> FileDescriptorProto -> ModuleName
moduleName modulePrefix fd = fromString (moduleNameStr modulePrefix fd)
moduleNameStr :: Text -> FileDescriptorProto -> String
moduleNameStr prefix fd = fixModuleName rawModuleName
where
path = fd ^. name
fixModuleName "" = ""
fixModuleName ('.':c:cs) = '.' : toUpper c : fixModuleName cs
fixModuleName ('_':c:cs) = toUpper c : fixModuleName cs
fixModuleName ('-':c:cs) = toUpper c : fixModuleName cs
fixModuleName (c:cs) = c : fixModuleName cs
rawModuleName = intercalate "." $ (T.unpack prefix :)
$ splitDirectories $ dropExtension
$ T.unpack path
transitiveExports :: [FileDescriptorProto] -> Map ProtoFileName [ProtoFileName]
transitiveExports = foldl' setExportsFromFile Map.empty
where
setExportsFromFile :: Map ProtoFileName [ProtoFileName]
-> FileDescriptorProto
-> Map ProtoFileName [ProtoFileName]
setExportsFromFile prevExports fd
= flip (Map.insert n) prevExports $
n : concat [ prevExports ! ((fd ^. dependency) !! fromIntegral i)
| i <- fd ^. publicDependency
]
where n = fd ^. name