module Data.ProtoLens.Compiler.ModuleName
    ( protoModuleName ) where

import Data.Char (toUpper)
import Data.List (intercalate)
import System.FilePath

-- | Get the Haskell module name corresponding to a given .proto file.
protoModuleName :: FilePath -> String
protoModuleName :: FilePath -> FilePath
protoModuleName FilePath
path = FilePath -> FilePath
fixModuleName FilePath
rawModuleName
  where
    fixModuleName :: FilePath -> FilePath
fixModuleName FilePath
"" = FilePath
""
    -- Characters allowed in Bazel filenames but not in module names:
    fixModuleName (Char
'.':Char
c:FilePath
cs) = Char
'.' forall a. a -> [a] -> [a]
: Char -> Char
toUpper Char
c forall a. a -> [a] -> [a]
: FilePath -> FilePath
fixModuleName FilePath
cs
    fixModuleName (Char
'_':Char
c:FilePath
cs) = Char -> Char
toUpper Char
c forall a. a -> [a] -> [a]
: FilePath -> FilePath
fixModuleName FilePath
cs
    fixModuleName (Char
'-':Char
c:FilePath
cs) = Char -> Char
toUpper Char
c forall a. a -> [a] -> [a]
: FilePath -> FilePath
fixModuleName FilePath
cs
    fixModuleName (Char
c:FilePath
cs) = Char
c forall a. a -> [a] -> [a]
: FilePath -> FilePath
fixModuleName FilePath
cs
    rawModuleName :: FilePath
rawModuleName = forall a. [a] -> [[a]] -> [a]
intercalate FilePath
"."
                        forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath
prefix forall a. a -> [a] -> [a]
:)
                        forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
splitDirectories forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
dropExtension
                        forall a b. (a -> b) -> a -> b
$ FilePath
path

prefix :: String
prefix :: FilePath
prefix = FilePath
"Proto"