{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ViewPatterns #-}
module Proto3.Suite.DotProto.Internal where
import Control.Applicative
import qualified Control.Foldl as FL
import Control.Lens (Lens', lens, over)
import Control.Lens.Cons (_head)
import Control.Monad
import Control.Monad.Except
import Data.Bifunctor (first)
import Data.Char
import Data.Coerce
import Data.Either
import Data.Foldable
import Data.Functor.Compose
import Data.Int (Int32)
import Data.List (find, intercalate)
import qualified Data.List.NonEmpty as NE
import qualified Data.Map as M
import Data.Maybe (fromMaybe)
import Data.Semigroup (Semigroup(..))
import qualified Data.Text as T
import Data.Tuple (swap)
import Filesystem.Path.CurrentOS ((</>))
import qualified Filesystem.Path.CurrentOS as FP
import qualified NeatInterpolation as Neat
import Prelude hiding (FilePath)
import Proto3.Suite.DotProto.AST
import Proto3.Suite.DotProto.AST.Lens
import Proto3.Suite.DotProto.Parsing
import Proto3.Wire.Types (FieldNumber (..))
import System.FilePath (isPathSeparator)
import Text.Parsec (ParseError)
import qualified Turtle
import Turtle (ExitCode (..), FilePath, MonadIO,
Text)
import Turtle.Format ((%))
import qualified Turtle.Format as F
#if !(MIN_VERSION_mtl(2,2,2))
liftEither :: MonadError e m => Either e a -> m a
liftEither = either throwError pure
#endif
foldMapM ::
(Foldable t, Monad m, Monoid b, Semigroup b) => (a -> m b) -> t a -> m b
foldMapM :: (a -> m b) -> t a -> m b
foldMapM a -> m b
f = (b -> a -> m b) -> b -> t a -> m b
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (\b
b a
a -> (b
b b -> b -> b
forall a. Semigroup a => a -> a -> a
<>) (b -> b) -> m b -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> m b
f a
a) b
forall a. Monoid a => a
mempty
type GettingM r s a = forall m. Applicative m => (a -> Compose m (Const r) a) -> s -> Compose m (Const r) s
foldMapOfM :: (Applicative m, Monoid r) => GettingM r s a -> (a -> m r) -> s -> m r
foldMapOfM :: GettingM r s a -> (a -> m r) -> s -> m r
foldMapOfM GettingM r s a
l a -> m r
f = (Const r s -> r) -> m (Const r s) -> m r
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Const r s -> r
forall a k (b :: k). Const a b -> a
getConst (m (Const r s) -> m r) -> (s -> m (Const r s)) -> s -> m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compose m (Const r) s -> m (Const r s)
forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose (Compose m (Const r) s -> m (Const r s))
-> (s -> Compose m (Const r) s) -> s -> m (Const r s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Compose m (Const r) a) -> s -> Compose m (Const r) s
GettingM r s a
l (m (Const r a) -> Compose m (Const r) a
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (m (Const r a) -> Compose m (Const r) a)
-> (a -> m (Const r a)) -> a -> Compose m (Const r) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (r -> Const r a) -> m r -> m (Const r a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap r -> Const r a
forall k a (b :: k). a -> Const a b
Const (m r -> m (Const r a)) -> (a -> m r) -> a -> m (Const r a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m r
f)
mapKeysM :: (Monad m, Ord k2) => (k1 -> m k2) -> M.Map k1 a -> m (M.Map k2 a)
mapKeysM :: (k1 -> m k2) -> Map k1 a -> m (Map k2 a)
mapKeysM k1 -> m k2
f = ([(k2, a)] -> Map k2 a) -> m [(k2, a)] -> m (Map k2 a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(k2, a)] -> Map k2 a
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList (m [(k2, a)] -> m (Map k2 a))
-> (Map k1 a -> m [(k2, a)]) -> Map k1 a -> m (Map k2 a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((k1, a) -> m (k2, a)) -> [(k1, a)] -> m [(k2, a)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (((a, k2) -> (k2, a)) -> m (a, k2) -> m (k2, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, k2) -> (k2, a)
forall a b. (a, b) -> (b, a)
swap (m (a, k2) -> m (k2, a))
-> ((k1, a) -> m (a, k2)) -> (k1, a) -> m (k2, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (k1 -> m k2) -> (a, k1) -> m (a, k2)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse k1 -> m k2
f ((a, k1) -> m (a, k2))
-> ((k1, a) -> (a, k1)) -> (k1, a) -> m (a, k2)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (k1, a) -> (a, k1)
forall a b. (a, b) -> (b, a)
swap) ([(k1, a)] -> m [(k2, a)])
-> (Map k1 a -> [(k1, a)]) -> Map k1 a -> m [(k2, a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map k1 a -> [(k1, a)]
forall k a. Map k a -> [(k, a)]
M.assocs
dieLines :: MonadIO m => Text -> m a
dieLines :: Text -> m a
dieLines (Text -> NonEmpty Line
Turtle.textToLines -> NonEmpty Line
msg) = do
(Line -> m ()) -> NonEmpty Line -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Line -> m ()
forall (io :: * -> *). MonadIO io => Line -> io ()
Turtle.err NonEmpty Line
msg
ExitCode -> m a
forall (io :: * -> *) a. MonadIO io => ExitCode -> io a
Turtle.exit (Int -> ExitCode
ExitFailure Int
1)
toModulePath :: FilePath -> Either String Path
toModulePath :: FilePath -> Either String Path
toModulePath fp0 :: FilePath
fp0@(FilePath -> Maybe FilePath -> FilePath
forall a. a -> Maybe a -> a
fromMaybe FilePath
fp0 (Maybe FilePath -> FilePath)
-> (FilePath -> Maybe FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath -> Maybe FilePath
FP.stripPrefix FilePath
"./" -> FilePath
fp)
| FilePath -> Bool
Turtle.absolute FilePath
fp
= String -> Either String Path
forall a b. a -> Either a b
Left String
"expected include-relative path"
| FilePath -> Maybe Text
Turtle.extension FilePath
fp Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"proto"
= String -> Either String Path
forall a b. a -> Either a b
Left String
"expected .proto suffix"
| Bool
otherwise
= case FilePath -> FilePath -> Maybe FilePath
FP.stripPrefix FilePath
"../" FilePath
fp of
Just{} -> String -> Either String Path
forall a b. a -> Either a b
Left String
"expected include-relative path, but the path started with ../"
Maybe FilePath
Nothing
| Text -> Text -> Bool
T.isInfixOf Text
".." (Text -> Bool) -> (FilePath -> Text) -> FilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format Text (FilePath -> Text) -> FilePath -> Text
forall r. Format Text r -> r
Turtle.format Format Text (FilePath -> Text)
forall r. Format r (FilePath -> r)
F.fp (FilePath -> Text) -> (FilePath -> FilePath) -> FilePath -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
FP.collapse (FilePath -> Bool) -> FilePath -> Bool
forall a b. (a -> b) -> a -> b
$ FilePath
fp
-> String -> Either String Path
forall a b. a -> Either a b
Left String
"path contained unexpected .. after canonicalization, please use form x.y.z.proto"
| Bool
otherwise
-> Either String Path
-> (NonEmpty String -> Either String Path)
-> Maybe (NonEmpty String)
-> Either String Path
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Either String Path
forall a b. a -> Either a b
Left String
"empty path after canonicalization") (Path -> Either String Path
forall a b. b -> Either a b
Right (Path -> Either String Path)
-> (NonEmpty String -> Path)
-> NonEmpty String
-> Either String Path
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty String -> Path
Path)
(Maybe (NonEmpty String) -> Either String Path)
-> (FilePath -> Maybe (NonEmpty String))
-> FilePath
-> Either String Path
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Maybe (NonEmpty String)
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty
([String] -> Maybe (NonEmpty String))
-> (FilePath -> [String]) -> FilePath -> Maybe (NonEmpty String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null
([String] -> [String])
-> (FilePath -> [String]) -> FilePath -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> String) -> [Text] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> String
T.unpack (Text -> String) -> (Text -> Text) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter Text Text Char Char -> (Char -> Char) -> Text -> Text
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter Text Text Char Char
forall s a. Cons s s a a => Traversal' s a
_head Char -> Char
toUpper)
([Text] -> [String])
-> (FilePath -> [Text]) -> FilePath -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> [Text]) -> [Text] -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Text -> Text -> [Text]
T.splitOn Text
".")
([Text] -> [Text]) -> (FilePath -> [Text]) -> FilePath -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> [Text]
T.split Char -> Bool
isPathSeparator
(Text -> [Text]) -> (FilePath -> Text) -> FilePath -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format Text (FilePath -> Text) -> FilePath -> Text
forall r. Format Text r -> r
Turtle.format Format Text (FilePath -> Text)
forall r. Format r (FilePath -> r)
F.fp
(FilePath -> Text) -> (FilePath -> FilePath) -> FilePath -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
FP.collapse
(FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
Turtle.dropExtension
(FilePath -> Either String Path) -> FilePath -> Either String Path
forall a b. (a -> b) -> a -> b
$ FilePath
fp
importProto :: (MonadIO m, MonadError CompileError m)
=> [FilePath] -> FilePath -> FilePath -> m DotProto
importProto :: [FilePath] -> FilePath -> FilePath -> m DotProto
importProto [FilePath]
paths FilePath
toplevelProto FilePath
protoFP =
[FilePath] -> FilePath -> m FindProtoResult
forall (m :: * -> *).
MonadIO m =>
[FilePath] -> FilePath -> m FindProtoResult
findProto [FilePath]
paths FilePath
protoFP m FindProtoResult -> (FindProtoResult -> m DotProto) -> m DotProto
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Left String
e
-> Text -> m DotProto
forall (m :: * -> *) a. MonadIO m => Text -> m a
dieLines (FilePath -> String -> Text
badModulePathErrorMsg FilePath
protoFP String
e)
Right Maybe (Path, FilePath)
Nothing
| FilePath
toplevelProto FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
protoFP
-> Text -> m DotProto
forall (m :: * -> *) a. MonadIO m => Text -> m a
dieLines ([FilePath] -> FilePath -> Text
toplevelNotFoundErrorMsg [FilePath]
paths FilePath
toplevelProto)
| Bool
otherwise
-> Text -> m DotProto
forall (m :: * -> *) a. MonadIO m => Text -> m a
dieLines ([FilePath] -> FilePath -> FilePath -> Text
importNotFoundErrorMsg [FilePath]
paths FilePath
toplevelProto FilePath
protoFP)
Right (Just (Path
mp, FilePath
fp))
-> Either CompileError DotProto -> m DotProto
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either CompileError DotProto -> m DotProto)
-> (Either ParseError DotProto -> Either CompileError DotProto)
-> Either ParseError DotProto
-> m DotProto
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ParseError -> CompileError)
-> Either ParseError DotProto -> Either CompileError DotProto
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ParseError -> CompileError
CompileParseError (Either ParseError DotProto -> m DotProto)
-> m (Either ParseError DotProto) -> m DotProto
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Path -> FilePath -> m (Either ParseError DotProto)
forall (m :: * -> *).
MonadIO m =>
Path -> FilePath -> m (Either ParseError DotProto)
parseProtoFile Path
mp FilePath
fp
type FindProtoResult = Either String (Maybe (Path, FilePath))
findProto :: MonadIO m => [FilePath] -> FilePath -> m FindProtoResult
findProto :: [FilePath] -> FilePath -> m FindProtoResult
findProto [FilePath]
searchPaths FilePath
protoFP
| FilePath -> Bool
Turtle.absolute FilePath
protoFP = Text -> m FindProtoResult
forall (m :: * -> *) a. MonadIO m => Text -> m a
dieLines Text
absolutePathErrorMsg
| Bool
otherwise = Either String Path
-> (Path -> m (Maybe (Path, FilePath))) -> m FindProtoResult
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (FilePath -> Either String Path
toModulePath FilePath
protoFP) ((Path -> m (Maybe (Path, FilePath))) -> m FindProtoResult)
-> (Path -> m (Maybe (Path, FilePath))) -> m FindProtoResult
forall a b. (a -> b) -> a -> b
$ \Path
mp ->
(Shell (Path, FilePath)
-> Fold (Path, FilePath) (Maybe (Path, FilePath))
-> m (Maybe (Path, FilePath)))
-> Fold (Path, FilePath) (Maybe (Path, FilePath))
-> Shell (Path, FilePath)
-> m (Maybe (Path, FilePath))
forall a b c. (a -> b -> c) -> b -> a -> c
flip Shell (Path, FilePath)
-> Fold (Path, FilePath) (Maybe (Path, FilePath))
-> m (Maybe (Path, FilePath))
forall (io :: * -> *) a b.
MonadIO io =>
Shell a -> Fold a b -> io b
Turtle.fold Fold (Path, FilePath) (Maybe (Path, FilePath))
forall a. Fold a (Maybe a)
FL.head (Shell (Path, FilePath) -> m (Maybe (Path, FilePath)))
-> Shell (Path, FilePath) -> m (Maybe (Path, FilePath))
forall a b. (a -> b) -> a -> b
$ do
FilePath
sp <- [FilePath] -> Shell FilePath
forall (f :: * -> *) a. Foldable f => f a -> Shell a
Turtle.select [FilePath]
searchPaths
let fp :: FilePath
fp = FilePath
sp FilePath -> FilePath -> FilePath
</> FilePath
protoFP
Bool
True <- FilePath -> Shell Bool
forall (io :: * -> *). MonadIO io => FilePath -> io Bool
Turtle.testfile FilePath
fp
(Path, FilePath) -> Shell (Path, FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Path
mp, FilePath
fp)
badModulePathErrorMsg :: FilePath -> String -> T.Text
badModulePathErrorMsg :: FilePath -> String -> Text
badModulePathErrorMsg (Format Text (FilePath -> Text) -> FilePath -> Text
forall r. Format Text r -> r
Turtle.format Format Text (FilePath -> Text)
forall r. Format r (FilePath -> r)
F.fp -> Text
fp) (String -> Text
T.pack -> Text
rsn) =
[Neat.text|
Error: failed when computing the "module path" for "${fp}": ${rsn}
Please ensure that the provided path to a .proto file is specified as
relative to some --includeDir path and that it has the .proto suffix.
|]
importNotFoundErrorMsg :: [FilePath] -> FilePath -> FilePath -> T.Text
importNotFoundErrorMsg :: [FilePath] -> FilePath -> FilePath -> Text
importNotFoundErrorMsg [FilePath]
paths FilePath
toplevelProto FilePath
protoFP =
[Neat.text|
Error: while processing include statements in "${toplevelProtoText}", failed
to find the imported file "${protoFPText}", after looking in the following
locations (controlled via the --includeDir switch(es)):
$pathsText
|]
where
pathsText :: Text
pathsText = [Text] -> Text
T.unlines (Format Text (FilePath -> Text) -> FilePath -> Text
forall r. Format Text r -> r
Turtle.format (Format (FilePath -> Text) (FilePath -> Text)
" "Format (FilePath -> Text) (FilePath -> Text)
-> Format Text (FilePath -> Text) -> Format Text (FilePath -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%Format Text (FilePath -> Text)
forall r. Format r (FilePath -> r)
F.fp) (FilePath -> Text) -> (FilePath -> FilePath) -> FilePath -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> FilePath -> FilePath
</> FilePath
protoFP) (FilePath -> Text) -> [FilePath] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FilePath]
paths)
toplevelProtoText :: Text
toplevelProtoText = Format Text (FilePath -> Text) -> FilePath -> Text
forall r. Format Text r -> r
Turtle.format Format Text (FilePath -> Text)
forall r. Format r (FilePath -> r)
F.fp FilePath
toplevelProto
protoFPText :: Text
protoFPText = Format Text (FilePath -> Text) -> FilePath -> Text
forall r. Format Text r -> r
Turtle.format Format Text (FilePath -> Text)
forall r. Format r (FilePath -> r)
F.fp FilePath
protoFP
toplevelNotFoundErrorMsg :: [FilePath] -> FilePath -> T.Text
toplevelNotFoundErrorMsg :: [FilePath] -> FilePath -> Text
toplevelNotFoundErrorMsg [FilePath]
searchPaths FilePath
toplevelProto =
[Neat.text|
Error: failed to find file "${toplevelProtoText}", after looking in
the following locations (controlled via the --includeDir switch(es)):
$searchPathsText
|]
where
searchPathsText :: Text
searchPathsText = [Text] -> Text
T.unlines (Format Text (FilePath -> Text) -> FilePath -> Text
forall r. Format Text r -> r
Turtle.format (Format (FilePath -> Text) (FilePath -> Text)
" "Format (FilePath -> Text) (FilePath -> Text)
-> Format Text (FilePath -> Text) -> Format Text (FilePath -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%Format Text (FilePath -> Text)
forall r. Format r (FilePath -> r)
F.fp) (FilePath -> Text) -> (FilePath -> FilePath) -> FilePath -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> FilePath -> FilePath
</> FilePath
toplevelProto) (FilePath -> Text) -> [FilePath] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FilePath]
searchPaths)
toplevelProtoText :: Text
toplevelProtoText = Format Text (FilePath -> Text) -> FilePath -> Text
forall r. Format Text r -> r
Turtle.format Format Text (FilePath -> Text)
forall r. Format r (FilePath -> r)
F.fp FilePath
toplevelProto
absolutePathErrorMsg :: T.Text
absolutePathErrorMsg :: Text
absolutePathErrorMsg =
[Neat.text|
Error: Absolute paths to .proto files, whether on the command line or
in include directives, are not currently permitted; rather, all .proto
filenames must be relative to the current directory, or relative to some
search path specified via --includeDir.
This is because we currently use the include-relative name to decide
the structure of the Haskell module tree that we emit during code
generation.
|]
type TypeContext = M.Map DotProtoIdentifier DotProtoTypeInfo
data DotProtoTypeInfo = DotProtoTypeInfo
{ DotProtoTypeInfo -> DotProtoPackageSpec
dotProtoTypeInfoPackage :: DotProtoPackageSpec
, DotProtoTypeInfo -> DotProtoIdentifier
dotProtoTypeInfoParent :: DotProtoIdentifier
, DotProtoTypeInfo -> TypeContext
dotProtoTypeChildContext :: TypeContext
, DotProtoTypeInfo -> DotProtoKind
dotProtoTypeInfoKind :: DotProtoKind
, DotProtoTypeInfo -> Path
dotProtoTypeInfoModulePath :: Path
} deriving Int -> DotProtoTypeInfo -> ShowS
[DotProtoTypeInfo] -> ShowS
DotProtoTypeInfo -> String
(Int -> DotProtoTypeInfo -> ShowS)
-> (DotProtoTypeInfo -> String)
-> ([DotProtoTypeInfo] -> ShowS)
-> Show DotProtoTypeInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DotProtoTypeInfo] -> ShowS
$cshowList :: [DotProtoTypeInfo] -> ShowS
show :: DotProtoTypeInfo -> String
$cshow :: DotProtoTypeInfo -> String
showsPrec :: Int -> DotProtoTypeInfo -> ShowS
$cshowsPrec :: Int -> DotProtoTypeInfo -> ShowS
Show
tiParent :: Lens' DotProtoTypeInfo DotProtoIdentifier
tiParent :: (DotProtoIdentifier -> f DotProtoIdentifier)
-> DotProtoTypeInfo -> f DotProtoTypeInfo
tiParent = (DotProtoTypeInfo -> DotProtoIdentifier)
-> (DotProtoTypeInfo -> DotProtoIdentifier -> DotProtoTypeInfo)
-> Lens
DotProtoTypeInfo
DotProtoTypeInfo
DotProtoIdentifier
DotProtoIdentifier
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens DotProtoTypeInfo -> DotProtoIdentifier
dotProtoTypeInfoParent (\DotProtoTypeInfo
d DotProtoIdentifier
p -> DotProtoTypeInfo
d{ dotProtoTypeInfoParent :: DotProtoIdentifier
dotProtoTypeInfoParent = DotProtoIdentifier
p })
data DotProtoKind = DotProtoKindEnum
| DotProtoKindMessage
deriving (Int -> DotProtoKind -> ShowS
[DotProtoKind] -> ShowS
DotProtoKind -> String
(Int -> DotProtoKind -> ShowS)
-> (DotProtoKind -> String)
-> ([DotProtoKind] -> ShowS)
-> Show DotProtoKind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DotProtoKind] -> ShowS
$cshowList :: [DotProtoKind] -> ShowS
show :: DotProtoKind -> String
$cshow :: DotProtoKind -> String
showsPrec :: Int -> DotProtoKind -> ShowS
$cshowsPrec :: Int -> DotProtoKind -> ShowS
Show, DotProtoKind -> DotProtoKind -> Bool
(DotProtoKind -> DotProtoKind -> Bool)
-> (DotProtoKind -> DotProtoKind -> Bool) -> Eq DotProtoKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DotProtoKind -> DotProtoKind -> Bool
$c/= :: DotProtoKind -> DotProtoKind -> Bool
== :: DotProtoKind -> DotProtoKind -> Bool
$c== :: DotProtoKind -> DotProtoKind -> Bool
Eq, Eq DotProtoKind
Eq DotProtoKind
-> (DotProtoKind -> DotProtoKind -> Ordering)
-> (DotProtoKind -> DotProtoKind -> Bool)
-> (DotProtoKind -> DotProtoKind -> Bool)
-> (DotProtoKind -> DotProtoKind -> Bool)
-> (DotProtoKind -> DotProtoKind -> Bool)
-> (DotProtoKind -> DotProtoKind -> DotProtoKind)
-> (DotProtoKind -> DotProtoKind -> DotProtoKind)
-> Ord DotProtoKind
DotProtoKind -> DotProtoKind -> Bool
DotProtoKind -> DotProtoKind -> Ordering
DotProtoKind -> DotProtoKind -> DotProtoKind
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DotProtoKind -> DotProtoKind -> DotProtoKind
$cmin :: DotProtoKind -> DotProtoKind -> DotProtoKind
max :: DotProtoKind -> DotProtoKind -> DotProtoKind
$cmax :: DotProtoKind -> DotProtoKind -> DotProtoKind
>= :: DotProtoKind -> DotProtoKind -> Bool
$c>= :: DotProtoKind -> DotProtoKind -> Bool
> :: DotProtoKind -> DotProtoKind -> Bool
$c> :: DotProtoKind -> DotProtoKind -> Bool
<= :: DotProtoKind -> DotProtoKind -> Bool
$c<= :: DotProtoKind -> DotProtoKind -> Bool
< :: DotProtoKind -> DotProtoKind -> Bool
$c< :: DotProtoKind -> DotProtoKind -> Bool
compare :: DotProtoKind -> DotProtoKind -> Ordering
$ccompare :: DotProtoKind -> DotProtoKind -> Ordering
$cp1Ord :: Eq DotProtoKind
Ord, Int -> DotProtoKind
DotProtoKind -> Int
DotProtoKind -> [DotProtoKind]
DotProtoKind -> DotProtoKind
DotProtoKind -> DotProtoKind -> [DotProtoKind]
DotProtoKind -> DotProtoKind -> DotProtoKind -> [DotProtoKind]
(DotProtoKind -> DotProtoKind)
-> (DotProtoKind -> DotProtoKind)
-> (Int -> DotProtoKind)
-> (DotProtoKind -> Int)
-> (DotProtoKind -> [DotProtoKind])
-> (DotProtoKind -> DotProtoKind -> [DotProtoKind])
-> (DotProtoKind -> DotProtoKind -> [DotProtoKind])
-> (DotProtoKind -> DotProtoKind -> DotProtoKind -> [DotProtoKind])
-> Enum DotProtoKind
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: DotProtoKind -> DotProtoKind -> DotProtoKind -> [DotProtoKind]
$cenumFromThenTo :: DotProtoKind -> DotProtoKind -> DotProtoKind -> [DotProtoKind]
enumFromTo :: DotProtoKind -> DotProtoKind -> [DotProtoKind]
$cenumFromTo :: DotProtoKind -> DotProtoKind -> [DotProtoKind]
enumFromThen :: DotProtoKind -> DotProtoKind -> [DotProtoKind]
$cenumFromThen :: DotProtoKind -> DotProtoKind -> [DotProtoKind]
enumFrom :: DotProtoKind -> [DotProtoKind]
$cenumFrom :: DotProtoKind -> [DotProtoKind]
fromEnum :: DotProtoKind -> Int
$cfromEnum :: DotProtoKind -> Int
toEnum :: Int -> DotProtoKind
$ctoEnum :: Int -> DotProtoKind
pred :: DotProtoKind -> DotProtoKind
$cpred :: DotProtoKind -> DotProtoKind
succ :: DotProtoKind -> DotProtoKind
$csucc :: DotProtoKind -> DotProtoKind
Enum, DotProtoKind
DotProtoKind -> DotProtoKind -> Bounded DotProtoKind
forall a. a -> a -> Bounded a
maxBound :: DotProtoKind
$cmaxBound :: DotProtoKind
minBound :: DotProtoKind
$cminBound :: DotProtoKind
Bounded)
dotProtoTypeContext :: MonadError CompileError m => DotProto -> m TypeContext
dotProtoTypeContext :: DotProto -> m TypeContext
dotProtoTypeContext DotProto{[DotProtoDefinition]
[DotProtoOption]
[DotProtoImport]
DotProtoMeta
DotProtoPackageSpec
protoMeta :: DotProto -> DotProtoMeta
protoDefinitions :: DotProto -> [DotProtoDefinition]
protoPackage :: DotProto -> DotProtoPackageSpec
protoOptions :: DotProto -> [DotProtoOption]
protoImports :: DotProto -> [DotProtoImport]
protoMeta :: DotProtoMeta
protoDefinitions :: [DotProtoDefinition]
protoPackage :: DotProtoPackageSpec
protoOptions :: [DotProtoOption]
protoImports :: [DotProtoImport]
..} =
(DotProtoDefinition -> m TypeContext)
-> [DotProtoDefinition] -> m TypeContext
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m, Monoid b, Semigroup b) =>
(a -> m b) -> t a -> m b
foldMapM (Path -> DotProtoDefinition -> m TypeContext
forall (m :: * -> *).
MonadError CompileError m =>
Path -> DotProtoDefinition -> m TypeContext
definitionTypeContext (DotProtoMeta -> Path
metaModulePath DotProtoMeta
protoMeta)) [DotProtoDefinition]
protoDefinitions
definitionTypeContext :: MonadError CompileError m
=> Path -> DotProtoDefinition -> m TypeContext
definitionTypeContext :: Path -> DotProtoDefinition -> m TypeContext
definitionTypeContext Path
modulePath (DotProtoMessage String
_ DotProtoIdentifier
msgIdent [DotProtoMessagePart]
parts) = do
let updateParent :: DotProtoTypeInfo -> m DotProtoTypeInfo
updateParent = (DotProtoIdentifier -> m DotProtoIdentifier)
-> DotProtoTypeInfo -> m DotProtoTypeInfo
Lens
DotProtoTypeInfo
DotProtoTypeInfo
DotProtoIdentifier
DotProtoIdentifier
tiParent (DotProtoIdentifier -> DotProtoIdentifier -> m DotProtoIdentifier
forall (m :: * -> *).
MonadError CompileError m =>
DotProtoIdentifier -> DotProtoIdentifier -> m DotProtoIdentifier
concatDotProtoIdentifier DotProtoIdentifier
msgIdent)
TypeContext
childTyContext <- GettingM TypeContext [DotProtoMessagePart] DotProtoDefinition
-> (DotProtoDefinition -> m TypeContext)
-> [DotProtoMessagePart]
-> m TypeContext
forall (m :: * -> *) r s a.
(Applicative m, Monoid r) =>
GettingM r s a -> (a -> m r) -> s -> m r
foldMapOfM ((DotProtoMessagePart
-> Compose m (Const TypeContext) DotProtoMessagePart)
-> [DotProtoMessagePart]
-> Compose m (Const TypeContext) [DotProtoMessagePart]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((DotProtoMessagePart
-> Compose m (Const TypeContext) DotProtoMessagePart)
-> [DotProtoMessagePart]
-> Compose m (Const TypeContext) [DotProtoMessagePart])
-> ((DotProtoDefinition
-> Compose m (Const TypeContext) DotProtoDefinition)
-> DotProtoMessagePart
-> Compose m (Const TypeContext) DotProtoMessagePart)
-> (DotProtoDefinition
-> Compose m (Const TypeContext) DotProtoDefinition)
-> [DotProtoMessagePart]
-> Compose m (Const TypeContext) [DotProtoMessagePart]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DotProtoDefinition
-> Compose m (Const TypeContext) DotProtoDefinition)
-> DotProtoMessagePart
-> Compose m (Const TypeContext) DotProtoMessagePart
Prism' DotProtoMessagePart DotProtoDefinition
_DotProtoMessageDefinition)
(Path -> DotProtoDefinition -> m TypeContext
forall (m :: * -> *).
MonadError CompileError m =>
Path -> DotProtoDefinition -> m TypeContext
definitionTypeContext Path
modulePath (DotProtoDefinition -> m TypeContext)
-> (TypeContext -> m TypeContext)
-> DotProtoDefinition
-> m TypeContext
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (DotProtoTypeInfo -> m DotProtoTypeInfo)
-> TypeContext -> m TypeContext
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse DotProtoTypeInfo -> m DotProtoTypeInfo
updateParent)
[DotProtoMessagePart]
parts
TypeContext
qualifiedChildTyContext <- (DotProtoIdentifier -> m DotProtoIdentifier)
-> TypeContext -> m TypeContext
forall (m :: * -> *) k2 k1 a.
(Monad m, Ord k2) =>
(k1 -> m k2) -> Map k1 a -> m (Map k2 a)
mapKeysM (DotProtoIdentifier -> DotProtoIdentifier -> m DotProtoIdentifier
forall (m :: * -> *).
MonadError CompileError m =>
DotProtoIdentifier -> DotProtoIdentifier -> m DotProtoIdentifier
concatDotProtoIdentifier DotProtoIdentifier
msgIdent) TypeContext
childTyContext
let tyInfo :: DotProtoTypeInfo
tyInfo = DotProtoTypeInfo :: DotProtoPackageSpec
-> DotProtoIdentifier
-> TypeContext
-> DotProtoKind
-> Path
-> DotProtoTypeInfo
DotProtoTypeInfo { dotProtoTypeInfoPackage :: DotProtoPackageSpec
dotProtoTypeInfoPackage = DotProtoPackageSpec
DotProtoNoPackage
, dotProtoTypeInfoParent :: DotProtoIdentifier
dotProtoTypeInfoParent = DotProtoIdentifier
Anonymous
, dotProtoTypeChildContext :: TypeContext
dotProtoTypeChildContext = TypeContext
childTyContext
, dotProtoTypeInfoKind :: DotProtoKind
dotProtoTypeInfoKind = DotProtoKind
DotProtoKindMessage
, dotProtoTypeInfoModulePath :: Path
dotProtoTypeInfoModulePath = Path
modulePath
}
TypeContext -> m TypeContext
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TypeContext -> m TypeContext) -> TypeContext -> m TypeContext
forall a b. (a -> b) -> a -> b
$ DotProtoIdentifier -> DotProtoTypeInfo -> TypeContext
forall k a. k -> a -> Map k a
M.singleton DotProtoIdentifier
msgIdent DotProtoTypeInfo
tyInfo TypeContext -> TypeContext -> TypeContext
forall a. Semigroup a => a -> a -> a
<> TypeContext
qualifiedChildTyContext
definitionTypeContext Path
modulePath (DotProtoEnum String
_ DotProtoIdentifier
enumIdent [DotProtoEnumPart]
_) = do
let tyInfo :: DotProtoTypeInfo
tyInfo = DotProtoTypeInfo :: DotProtoPackageSpec
-> DotProtoIdentifier
-> TypeContext
-> DotProtoKind
-> Path
-> DotProtoTypeInfo
DotProtoTypeInfo { dotProtoTypeInfoPackage :: DotProtoPackageSpec
dotProtoTypeInfoPackage = DotProtoPackageSpec
DotProtoNoPackage
, dotProtoTypeInfoParent :: DotProtoIdentifier
dotProtoTypeInfoParent = DotProtoIdentifier
Anonymous
, dotProtoTypeChildContext :: TypeContext
dotProtoTypeChildContext = TypeContext
forall a. Monoid a => a
mempty
, dotProtoTypeInfoKind :: DotProtoKind
dotProtoTypeInfoKind = DotProtoKind
DotProtoKindEnum
, dotProtoTypeInfoModulePath :: Path
dotProtoTypeInfoModulePath = Path
modulePath
}
TypeContext -> m TypeContext
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DotProtoIdentifier -> DotProtoTypeInfo -> TypeContext
forall k a. k -> a -> Map k a
M.singleton DotProtoIdentifier
enumIdent DotProtoTypeInfo
tyInfo)
definitionTypeContext Path
_ DotProtoDefinition
_ = TypeContext -> m TypeContext
forall (f :: * -> *) a. Applicative f => a -> f a
pure TypeContext
forall a. Monoid a => a
mempty
isMessage :: TypeContext -> DotProtoIdentifier -> Bool
isMessage :: TypeContext -> DotProtoIdentifier -> Bool
isMessage TypeContext
ctxt DotProtoIdentifier
n = DotProtoKind -> Maybe DotProtoKind
forall a. a -> Maybe a
Just DotProtoKind
DotProtoKindMessage Maybe DotProtoKind -> Maybe DotProtoKind -> Bool
forall a. Eq a => a -> a -> Bool
== (DotProtoTypeInfo -> DotProtoKind
dotProtoTypeInfoKind (DotProtoTypeInfo -> DotProtoKind)
-> Maybe DotProtoTypeInfo -> Maybe DotProtoKind
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DotProtoIdentifier -> TypeContext -> Maybe DotProtoTypeInfo
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup DotProtoIdentifier
n TypeContext
ctxt)
isPacked :: [DotProtoOption] -> Bool
isPacked :: [DotProtoOption] -> Bool
isPacked [DotProtoOption]
opts =
case (DotProtoOption -> Bool)
-> [DotProtoOption] -> Maybe DotProtoOption
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(DotProtoOption DotProtoIdentifier
name DotProtoValue
_) -> DotProtoIdentifier
name DotProtoIdentifier -> DotProtoIdentifier -> Bool
forall a. Eq a => a -> a -> Bool
== String -> DotProtoIdentifier
Single String
"packed") [DotProtoOption]
opts of
Just (DotProtoOption DotProtoIdentifier
_ (BoolLit Bool
x)) -> Bool
x
Maybe DotProtoOption
_ -> Bool
False
isUnpacked :: [DotProtoOption] -> Bool
isUnpacked :: [DotProtoOption] -> Bool
isUnpacked [DotProtoOption]
opts =
case (DotProtoOption -> Bool)
-> [DotProtoOption] -> Maybe DotProtoOption
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(DotProtoOption DotProtoIdentifier
name DotProtoValue
_) -> DotProtoIdentifier
name DotProtoIdentifier -> DotProtoIdentifier -> Bool
forall a. Eq a => a -> a -> Bool
== String -> DotProtoIdentifier
Single String
"packed") [DotProtoOption]
opts of
Just (DotProtoOption DotProtoIdentifier
_ (BoolLit Bool
x)) -> Bool -> Bool
not Bool
x
Maybe DotProtoOption
_ -> Bool
False
isPackable :: TypeContext -> DotProtoPrimType -> Bool
isPackable :: TypeContext -> DotProtoPrimType -> Bool
isPackable TypeContext
_ DotProtoPrimType
Bytes = Bool
False
isPackable TypeContext
_ DotProtoPrimType
String = Bool
False
isPackable TypeContext
_ DotProtoPrimType
Int32 = Bool
True
isPackable TypeContext
_ DotProtoPrimType
Int64 = Bool
True
isPackable TypeContext
_ DotProtoPrimType
SInt32 = Bool
True
isPackable TypeContext
_ DotProtoPrimType
SInt64 = Bool
True
isPackable TypeContext
_ DotProtoPrimType
UInt32 = Bool
True
isPackable TypeContext
_ DotProtoPrimType
UInt64 = Bool
True
isPackable TypeContext
_ DotProtoPrimType
Fixed32 = Bool
True
isPackable TypeContext
_ DotProtoPrimType
Fixed64 = Bool
True
isPackable TypeContext
_ DotProtoPrimType
SFixed32 = Bool
True
isPackable TypeContext
_ DotProtoPrimType
SFixed64 = Bool
True
isPackable TypeContext
_ DotProtoPrimType
Bool = Bool
True
isPackable TypeContext
_ DotProtoPrimType
Float = Bool
True
isPackable TypeContext
_ DotProtoPrimType
Double = Bool
True
isPackable TypeContext
ctxt (Named DotProtoIdentifier
tyName) =
DotProtoKind -> Maybe DotProtoKind
forall a. a -> Maybe a
Just DotProtoKind
DotProtoKindEnum Maybe DotProtoKind -> Maybe DotProtoKind -> Bool
forall a. Eq a => a -> a -> Bool
== (DotProtoTypeInfo -> DotProtoKind
dotProtoTypeInfoKind (DotProtoTypeInfo -> DotProtoKind)
-> Maybe DotProtoTypeInfo -> Maybe DotProtoKind
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DotProtoIdentifier -> TypeContext -> Maybe DotProtoTypeInfo
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup DotProtoIdentifier
tyName TypeContext
ctxt)
isMap :: DotProtoType -> Bool
isMap :: DotProtoType -> Bool
isMap Map{} = Bool
True
isMap DotProtoType
_ = Bool
False
concatDotProtoIdentifier :: MonadError CompileError m
=> DotProtoIdentifier -> DotProtoIdentifier -> m DotProtoIdentifier
concatDotProtoIdentifier :: DotProtoIdentifier -> DotProtoIdentifier -> m DotProtoIdentifier
concatDotProtoIdentifier DotProtoIdentifier
i1 DotProtoIdentifier
i2 = case (DotProtoIdentifier
i1, DotProtoIdentifier
i2) of
(Qualified{} , DotProtoIdentifier
_ ) -> String -> m DotProtoIdentifier
forall (m :: * -> *) a. MonadError CompileError m => String -> m a
internalError String
"concatDotProtoIdentifier: Qualified"
(DotProtoIdentifier
_ , Qualified{} ) -> String -> m DotProtoIdentifier
forall (m :: * -> *) a. MonadError CompileError m => String -> m a
internalError String
"concatDotProtoIdentifier Qualified"
(DotProtoIdentifier
Anonymous , DotProtoIdentifier
Anonymous ) -> DotProtoIdentifier -> m DotProtoIdentifier
forall (f :: * -> *) a. Applicative f => a -> f a
pure DotProtoIdentifier
Anonymous
(DotProtoIdentifier
Anonymous , DotProtoIdentifier
b ) -> DotProtoIdentifier -> m DotProtoIdentifier
forall (f :: * -> *) a. Applicative f => a -> f a
pure DotProtoIdentifier
b
(DotProtoIdentifier
a , DotProtoIdentifier
Anonymous ) -> DotProtoIdentifier -> m DotProtoIdentifier
forall (f :: * -> *) a. Applicative f => a -> f a
pure DotProtoIdentifier
a
(Single String
a , DotProtoIdentifier
b ) -> DotProtoIdentifier -> DotProtoIdentifier -> m DotProtoIdentifier
forall (m :: * -> *).
MonadError CompileError m =>
DotProtoIdentifier -> DotProtoIdentifier -> m DotProtoIdentifier
concatDotProtoIdentifier (Path -> DotProtoIdentifier
Dots (NonEmpty String -> Path
Path (String -> NonEmpty String
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
a))) DotProtoIdentifier
b
(DotProtoIdentifier
a , Single String
b ) -> DotProtoIdentifier -> DotProtoIdentifier -> m DotProtoIdentifier
forall (m :: * -> *).
MonadError CompileError m =>
DotProtoIdentifier -> DotProtoIdentifier -> m DotProtoIdentifier
concatDotProtoIdentifier DotProtoIdentifier
a (Path -> DotProtoIdentifier
Dots (NonEmpty String -> Path
Path (String -> NonEmpty String
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
b)))
(Dots (Path NonEmpty String
a), Dots (Path NonEmpty String
b)) -> DotProtoIdentifier -> m DotProtoIdentifier
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Path -> DotProtoIdentifier
Dots (NonEmpty String -> Path
Path (NonEmpty String
a NonEmpty String -> NonEmpty String -> NonEmpty String
forall a. Semigroup a => a -> a -> a
<> NonEmpty String
b)))
camelCased :: String -> String
camelCased :: ShowS
camelCased String
s = do
(Maybe Char
prev, Maybe Char
cur) <- [Maybe Char] -> [Maybe Char] -> [(Maybe Char, Maybe Char)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Maybe Char
forall a. Maybe a
NothingMaybe Char -> [Maybe Char] -> [Maybe Char]
forall a. a -> [a] -> [a]
:(Char -> Maybe Char) -> String -> [Maybe Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Maybe Char
forall a. a -> Maybe a
Just String
s) ((Char -> Maybe Char) -> String -> [Maybe Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Maybe Char
forall a. a -> Maybe a
Just String
s [Maybe Char] -> [Maybe Char] -> [Maybe Char]
forall a. [a] -> [a] -> [a]
++ [Maybe Char
forall a. Maybe a
Nothing])
case (Maybe Char
prev, Maybe Char
cur) of
(Just Char
'_', Just Char
x)
| Char -> Bool
isAlpha Char
x -> Char -> String
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Char -> Char
toUpper Char
x)
(Just Char
'_', Maybe Char
Nothing) -> Char -> String
forall (f :: * -> *) a. Applicative f => a -> f a
pure Char
'_'
(Just Char
'_', Just Char
'_') -> Char -> String
forall (f :: * -> *) a. Applicative f => a -> f a
pure Char
'_'
(Maybe Char
_, Just Char
'_') -> String
forall (f :: * -> *) a. Alternative f => f a
empty
(Maybe Char
_, Just Char
x) -> Char -> String
forall (f :: * -> *) a. Applicative f => a -> f a
pure Char
x
(Maybe Char
_, Maybe Char
_) -> String
forall (f :: * -> *) a. Alternative f => f a
empty
typeLikeName :: MonadError CompileError m => String -> m String
typeLikeName :: String -> m String
typeLikeName ident :: String
ident@(Char
c:String
cs)
| Char -> Bool
isUpper Char
c = String -> m String
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ShowS
camelCased String
ident)
| Char -> Bool
isLower Char
c = String -> m String
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ShowS
camelCased (Char -> Char
toUpper Char
c Char -> ShowS
forall a. a -> [a] -> [a]
: String
cs))
| Char
'_' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c = String -> m String
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ShowS
camelCased (Char
'X'Char -> ShowS
forall a. a -> [a] -> [a]
:String
ident))
typeLikeName String
ident = String -> m String
forall (m :: * -> *) a. MonadError CompileError m => String -> m a
invalidTypeNameError String
ident
fieldLikeName :: String -> String
fieldLikeName :: ShowS
fieldLikeName ident :: String
ident@(Char
c:String
_)
| Char -> Bool
isUpper Char
c = let (String
prefix, String
suffix) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isUpper String
ident
in (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
prefix String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
suffix
fieldLikeName String
ident = String
ident
prefixedEnumFieldName :: String -> String -> String
prefixedEnumFieldName :: String -> ShowS
prefixedEnumFieldName String
enumName String
fieldName = String
enumName String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
fieldName
prefixedConName :: MonadError CompileError m => String -> String -> m String
prefixedConName :: String -> String -> m String
prefixedConName String
msgName String
conName = (String
msgName String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> m String -> m String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> m String
forall (m :: * -> *).
MonadError CompileError m =>
String -> m String
typeLikeName String
conName
prefixedFieldName :: MonadError CompileError m => String -> String -> m String
prefixedFieldName :: String -> String -> m String
prefixedFieldName String
msgName String
fieldName = (ShowS
fieldLikeName String
msgName String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> m String -> m String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> m String
forall (m :: * -> *).
MonadError CompileError m =>
String -> m String
typeLikeName String
fieldName
dpIdentUnqualName :: MonadError CompileError m => DotProtoIdentifier -> m String
dpIdentUnqualName :: DotProtoIdentifier -> m String
dpIdentUnqualName (Single String
name) = String -> m String
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
name
dpIdentUnqualName (Dots (Path NonEmpty String
names)) = String -> m String
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NonEmpty String -> String
forall a. NonEmpty a -> a
NE.last NonEmpty String
names)
dpIdentUnqualName (Qualified DotProtoIdentifier
_ DotProtoIdentifier
next) = DotProtoIdentifier -> m String
forall (m :: * -> *).
MonadError CompileError m =>
DotProtoIdentifier -> m String
dpIdentUnqualName DotProtoIdentifier
next
dpIdentUnqualName DotProtoIdentifier
Anonymous = String -> m String
forall (m :: * -> *) a. MonadError CompileError m => String -> m a
internalError String
"dpIdentUnqualName: Anonymous"
dpIdentQualName :: MonadError CompileError m => DotProtoIdentifier -> m String
dpIdentQualName :: DotProtoIdentifier -> m String
dpIdentQualName (Single String
name) = String -> m String
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
name
dpIdentQualName (Dots (Path NonEmpty String
names)) = String -> m String
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"." (NonEmpty String -> [String]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty String
names))
dpIdentQualName (Qualified DotProtoIdentifier
_ DotProtoIdentifier
_) = String -> m String
forall (m :: * -> *) a. MonadError CompileError m => String -> m a
internalError String
"dpIdentQualName: Qualified"
dpIdentQualName DotProtoIdentifier
Anonymous = String -> m String
forall (m :: * -> *) a. MonadError CompileError m => String -> m a
internalError String
"dpIdentQualName: Anonymous"
nestedTypeName :: MonadError CompileError m => DotProtoIdentifier -> String -> m String
nestedTypeName :: DotProtoIdentifier -> String -> m String
nestedTypeName DotProtoIdentifier
Anonymous String
nm = String -> m String
forall (m :: * -> *).
MonadError CompileError m =>
String -> m String
typeLikeName String
nm
nestedTypeName (Single String
parent) String
nm = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"_" ([String] -> String) -> m [String] -> m String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> m String) -> [String] -> m [String]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse String -> m String
forall (m :: * -> *).
MonadError CompileError m =>
String -> m String
typeLikeName [String
parent, String
nm]
nestedTypeName (Dots (Path NonEmpty String
parents)) String
nm = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"_" ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String
nm]) ([String] -> String) -> m [String] -> m String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> m String) -> [String] -> m [String]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse String -> m String
forall (m :: * -> *).
MonadError CompileError m =>
String -> m String
typeLikeName (NonEmpty String -> [String]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty String
parents)
nestedTypeName (Qualified {}) String
_ = String -> m String
forall (m :: * -> *) a. MonadError CompileError m => String -> m a
internalError String
"nestedTypeName: Qualified"
qualifiedMessageName :: MonadError CompileError m => DotProtoIdentifier -> DotProtoIdentifier -> m String
qualifiedMessageName :: DotProtoIdentifier -> DotProtoIdentifier -> m String
qualifiedMessageName DotProtoIdentifier
parentIdent DotProtoIdentifier
msgIdent = DotProtoIdentifier -> String -> m String
forall (m :: * -> *).
MonadError CompileError m =>
DotProtoIdentifier -> String -> m String
nestedTypeName DotProtoIdentifier
parentIdent (String -> m String) -> m String -> m String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< DotProtoIdentifier -> m String
forall (m :: * -> *).
MonadError CompileError m =>
DotProtoIdentifier -> m String
dpIdentUnqualName DotProtoIdentifier
msgIdent
data QualifiedField = QualifiedField
{ QualifiedField -> FieldName
recordFieldName :: FieldName
, QualifiedField -> FieldInfo
fieldInfo :: FieldInfo
} deriving Int -> QualifiedField -> ShowS
[QualifiedField] -> ShowS
QualifiedField -> String
(Int -> QualifiedField -> ShowS)
-> (QualifiedField -> String)
-> ([QualifiedField] -> ShowS)
-> Show QualifiedField
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [QualifiedField] -> ShowS
$cshowList :: [QualifiedField] -> ShowS
show :: QualifiedField -> String
$cshow :: QualifiedField -> String
showsPrec :: Int -> QualifiedField -> ShowS
$cshowsPrec :: Int -> QualifiedField -> ShowS
Show
data FieldInfo
= FieldOneOf OneofField
| FieldNormal FieldName FieldNumber DotProtoType [DotProtoOption]
deriving Int -> FieldInfo -> ShowS
[FieldInfo] -> ShowS
FieldInfo -> String
(Int -> FieldInfo -> ShowS)
-> (FieldInfo -> String)
-> ([FieldInfo] -> ShowS)
-> Show FieldInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FieldInfo] -> ShowS
$cshowList :: [FieldInfo] -> ShowS
show :: FieldInfo -> String
$cshow :: FieldInfo -> String
showsPrec :: Int -> FieldInfo -> ShowS
$cshowsPrec :: Int -> FieldInfo -> ShowS
Show
data OneofField = OneofField
{ OneofField -> String
oneofType :: String
, OneofField -> [OneofSubfield]
subfields :: [OneofSubfield]
} deriving Int -> OneofField -> ShowS
[OneofField] -> ShowS
OneofField -> String
(Int -> OneofField -> ShowS)
-> (OneofField -> String)
-> ([OneofField] -> ShowS)
-> Show OneofField
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OneofField] -> ShowS
$cshowList :: [OneofField] -> ShowS
show :: OneofField -> String
$cshow :: OneofField -> String
showsPrec :: Int -> OneofField -> ShowS
$cshowsPrec :: Int -> OneofField -> ShowS
Show
data OneofSubfield = OneofSubfield
{ OneofSubfield -> FieldNumber
subfieldNumber :: FieldNumber
, OneofSubfield -> String
subfieldConsName :: String
, OneofSubfield -> FieldName
subfieldName :: FieldName
, OneofSubfield -> DotProtoType
subfieldType :: DotProtoType
, OneofSubfield -> [DotProtoOption]
subfieldOptions :: [DotProtoOption]
} deriving Int -> OneofSubfield -> ShowS
[OneofSubfield] -> ShowS
OneofSubfield -> String
(Int -> OneofSubfield -> ShowS)
-> (OneofSubfield -> String)
-> ([OneofSubfield] -> ShowS)
-> Show OneofSubfield
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OneofSubfield] -> ShowS
$cshowList :: [OneofSubfield] -> ShowS
show :: OneofSubfield -> String
$cshow :: OneofSubfield -> String
showsPrec :: Int -> OneofSubfield -> ShowS
$cshowsPrec :: Int -> OneofSubfield -> ShowS
Show
getQualifiedFields :: MonadError CompileError m
=> String -> [DotProtoMessagePart] -> m [QualifiedField]
getQualifiedFields :: String -> [DotProtoMessagePart] -> m [QualifiedField]
getQualifiedFields String
msgName [DotProtoMessagePart]
msgParts = ((DotProtoMessagePart -> m [QualifiedField])
-> [DotProtoMessagePart] -> m [QualifiedField])
-> [DotProtoMessagePart]
-> (DotProtoMessagePart -> m [QualifiedField])
-> m [QualifiedField]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (DotProtoMessagePart -> m [QualifiedField])
-> [DotProtoMessagePart] -> m [QualifiedField]
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m, Monoid b, Semigroup b) =>
(a -> m b) -> t a -> m b
foldMapM [DotProtoMessagePart]
msgParts ((DotProtoMessagePart -> m [QualifiedField]) -> m [QualifiedField])
-> (DotProtoMessagePart -> m [QualifiedField])
-> m [QualifiedField]
forall a b. (a -> b) -> a -> b
$ \case
DotProtoMessageField DotProtoField{String
[DotProtoOption]
FieldNumber
DotProtoType
DotProtoIdentifier
dotProtoFieldComment :: DotProtoField -> String
dotProtoFieldOptions :: DotProtoField -> [DotProtoOption]
dotProtoFieldName :: DotProtoField -> DotProtoIdentifier
dotProtoFieldType :: DotProtoField -> DotProtoType
dotProtoFieldNumber :: DotProtoField -> FieldNumber
dotProtoFieldComment :: String
dotProtoFieldOptions :: [DotProtoOption]
dotProtoFieldName :: DotProtoIdentifier
dotProtoFieldType :: DotProtoType
dotProtoFieldNumber :: FieldNumber
..} -> do
String
fieldName <- DotProtoIdentifier -> m String
forall (m :: * -> *).
MonadError CompileError m =>
DotProtoIdentifier -> m String
dpIdentUnqualName DotProtoIdentifier
dotProtoFieldName
String
qualName <- String -> String -> m String
forall (m :: * -> *).
MonadError CompileError m =>
String -> String -> m String
prefixedFieldName String
msgName String
fieldName
[QualifiedField] -> m [QualifiedField]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([QualifiedField] -> m [QualifiedField])
-> (QualifiedField -> [QualifiedField])
-> QualifiedField
-> m [QualifiedField]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (QualifiedField -> [QualifiedField] -> [QualifiedField]
forall a. a -> [a] -> [a]
:[]) (QualifiedField -> m [QualifiedField])
-> QualifiedField -> m [QualifiedField]
forall a b. (a -> b) -> a -> b
$ QualifiedField :: FieldName -> FieldInfo -> QualifiedField
QualifiedField { recordFieldName :: FieldName
recordFieldName = String -> FieldName
coerce String
qualName
, fieldInfo :: FieldInfo
fieldInfo = FieldName
-> FieldNumber -> DotProtoType -> [DotProtoOption] -> FieldInfo
FieldNormal (String -> FieldName
coerce String
fieldName)
FieldNumber
dotProtoFieldNumber
DotProtoType
dotProtoFieldType
[DotProtoOption]
dotProtoFieldOptions
}
DotProtoMessageOneOf DotProtoIdentifier
_ [] ->
CompileError -> m [QualifiedField]
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> CompileError
InternalError String
"getQualifiedFields: encountered oneof with no oneof fields")
DotProtoMessageOneOf DotProtoIdentifier
oneofIdent [DotProtoField]
fields -> do
String
ident <- DotProtoIdentifier -> m String
forall (m :: * -> *).
MonadError CompileError m =>
DotProtoIdentifier -> m String
dpIdentUnqualName DotProtoIdentifier
oneofIdent
String
oneofName <- String -> String -> m String
forall (m :: * -> *).
MonadError CompileError m =>
String -> String -> m String
prefixedFieldName String
msgName String
ident
String
oneofTypeName <- String -> String -> m String
forall (m :: * -> *).
MonadError CompileError m =>
String -> String -> m String
prefixedConName String
msgName String
ident
let mkSubfield :: DotProtoField -> m [OneofSubfield]
mkSubfield DotProtoField{String
[DotProtoOption]
FieldNumber
DotProtoType
DotProtoIdentifier
dotProtoFieldComment :: String
dotProtoFieldOptions :: [DotProtoOption]
dotProtoFieldName :: DotProtoIdentifier
dotProtoFieldType :: DotProtoType
dotProtoFieldNumber :: FieldNumber
dotProtoFieldComment :: DotProtoField -> String
dotProtoFieldOptions :: DotProtoField -> [DotProtoOption]
dotProtoFieldName :: DotProtoField -> DotProtoIdentifier
dotProtoFieldType :: DotProtoField -> DotProtoType
dotProtoFieldNumber :: DotProtoField -> FieldNumber
..} = do
String
s <- DotProtoIdentifier -> m String
forall (m :: * -> *).
MonadError CompileError m =>
DotProtoIdentifier -> m String
dpIdentUnqualName DotProtoIdentifier
dotProtoFieldName
String
c <- String -> String -> m String
forall (m :: * -> *).
MonadError CompileError m =>
String -> String -> m String
prefixedConName String
oneofTypeName String
s
[OneofSubfield] -> m [OneofSubfield]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [FieldNumber
-> String
-> FieldName
-> DotProtoType
-> [DotProtoOption]
-> OneofSubfield
OneofSubfield FieldNumber
dotProtoFieldNumber String
c (String -> FieldName
coerce String
s) DotProtoType
dotProtoFieldType [DotProtoOption]
dotProtoFieldOptions]
mkSubfield DotProtoField
DotProtoEmptyField = [OneofSubfield] -> m [OneofSubfield]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
[OneofSubfield]
fieldElems <- (DotProtoField -> m [OneofSubfield])
-> [DotProtoField] -> m [OneofSubfield]
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m, Monoid b, Semigroup b) =>
(a -> m b) -> t a -> m b
foldMapM DotProtoField -> m [OneofSubfield]
forall (m :: * -> *).
MonadError CompileError m =>
DotProtoField -> m [OneofSubfield]
mkSubfield [DotProtoField]
fields
[QualifiedField] -> m [QualifiedField]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([QualifiedField] -> m [QualifiedField])
-> (QualifiedField -> [QualifiedField])
-> QualifiedField
-> m [QualifiedField]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (QualifiedField -> [QualifiedField] -> [QualifiedField]
forall a. a -> [a] -> [a]
:[]) (QualifiedField -> m [QualifiedField])
-> QualifiedField -> m [QualifiedField]
forall a b. (a -> b) -> a -> b
$ QualifiedField :: FieldName -> FieldInfo -> QualifiedField
QualifiedField { recordFieldName :: FieldName
recordFieldName = String -> FieldName
coerce String
oneofName
, fieldInfo :: FieldInfo
fieldInfo = OneofField -> FieldInfo
FieldOneOf (String -> [OneofSubfield] -> OneofField
OneofField String
ident [OneofSubfield]
fieldElems)
}
DotProtoMessagePart
_ -> [QualifiedField] -> m [QualifiedField]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
foldQF :: (FieldName -> FieldNumber -> a)
-> (OneofField -> a)
-> QualifiedField
-> a
foldQF :: (FieldName -> FieldNumber -> a)
-> (OneofField -> a) -> QualifiedField -> a
foldQF FieldName -> FieldNumber -> a
f OneofField -> a
_ (QualifiedField FieldName
_ (FieldNormal FieldName
fldName FieldNumber
fldNum DotProtoType
_ [DotProtoOption]
_)) = FieldName -> FieldNumber -> a
f FieldName
fldName FieldNumber
fldNum
foldQF FieldName -> FieldNumber -> a
_ OneofField -> a
g (QualifiedField FieldName
_ (FieldOneOf OneofField
fld)) = OneofField -> a
g OneofField
fld
fieldBinder :: FieldNumber -> String
fieldBinder :: FieldNumber -> String
fieldBinder = (String
"f" String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> (FieldNumber -> String) -> FieldNumber -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldNumber -> String
forall a. Show a => a -> String
show
oneofSubBinder :: OneofSubfield -> String
oneofSubBinder :: OneofSubfield -> String
oneofSubBinder = FieldNumber -> String
fieldBinder (FieldNumber -> String)
-> (OneofSubfield -> FieldNumber) -> OneofSubfield -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OneofSubfield -> FieldNumber
subfieldNumber
oneofSubDisjunctBinder :: [OneofSubfield] -> String
oneofSubDisjunctBinder :: [OneofSubfield] -> String
oneofSubDisjunctBinder = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"_or_" ([String] -> String)
-> ([OneofSubfield] -> [String]) -> [OneofSubfield] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (OneofSubfield -> String) -> [OneofSubfield] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap OneofSubfield -> String
oneofSubBinder
data CompileError
= CircularImport FilePath
| CompileParseError ParseError
| InternalError String
| InvalidPackageName DotProtoIdentifier
| InvalidMethodName DotProtoIdentifier
| InvalidTypeName String
| InvalidMapKeyType String
| NoPackageDeclaration
| NoSuchType DotProtoIdentifier
| NonzeroFirstEnumeration String DotProtoIdentifier Int32
| EmptyEnumeration String
| Unimplemented String
deriving (Int -> CompileError -> ShowS
[CompileError] -> ShowS
CompileError -> String
(Int -> CompileError -> ShowS)
-> (CompileError -> String)
-> ([CompileError] -> ShowS)
-> Show CompileError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompileError] -> ShowS
$cshowList :: [CompileError] -> ShowS
show :: CompileError -> String
$cshow :: CompileError -> String
showsPrec :: Int -> CompileError -> ShowS
$cshowsPrec :: Int -> CompileError -> ShowS
Show, CompileError -> CompileError -> Bool
(CompileError -> CompileError -> Bool)
-> (CompileError -> CompileError -> Bool) -> Eq CompileError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompileError -> CompileError -> Bool
$c/= :: CompileError -> CompileError -> Bool
== :: CompileError -> CompileError -> Bool
$c== :: CompileError -> CompileError -> Bool
Eq)
internalError :: MonadError CompileError m => String -> m a
internalError :: String -> m a
internalError = CompileError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (CompileError -> m a) -> (String -> CompileError) -> String -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> CompileError
InternalError
invalidTypeNameError :: MonadError CompileError m => String -> m a
invalidTypeNameError :: String -> m a
invalidTypeNameError = CompileError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (CompileError -> m a) -> (String -> CompileError) -> String -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> CompileError
InvalidTypeName
_unimplementedError :: MonadError CompileError m => String -> m a
_unimplementedError :: String -> m a
_unimplementedError = CompileError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (CompileError -> m a) -> (String -> CompileError) -> String -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> CompileError
Unimplemented
invalidMethodNameError :: MonadError CompileError m => DotProtoIdentifier -> m a
invalidMethodNameError :: DotProtoIdentifier -> m a
invalidMethodNameError = CompileError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (CompileError -> m a)
-> (DotProtoIdentifier -> CompileError)
-> DotProtoIdentifier
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DotProtoIdentifier -> CompileError
InvalidMethodName
noSuchTypeError :: MonadError CompileError m => DotProtoIdentifier -> m a
noSuchTypeError :: DotProtoIdentifier -> m a
noSuchTypeError = CompileError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (CompileError -> m a)
-> (DotProtoIdentifier -> CompileError)
-> DotProtoIdentifier
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DotProtoIdentifier -> CompileError
NoSuchType
protoPackageName :: MonadError CompileError m => DotProtoPackageSpec -> m DotProtoIdentifier
protoPackageName :: DotProtoPackageSpec -> m DotProtoIdentifier
protoPackageName (DotProtoPackageSpec DotProtoIdentifier
name) = DotProtoIdentifier -> m DotProtoIdentifier
forall (f :: * -> *) a. Applicative f => a -> f a
pure DotProtoIdentifier
name
protoPackageName DotProtoPackageSpec
DotProtoNoPackage = CompileError -> m DotProtoIdentifier
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError CompileError
NoPackageDeclaration