-- | This module provides misc internal helpers and utilities

{-# LANGUAGE CPP               #-}
{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE MultiWayIf        #-}
{-# LANGUAGE NamedFieldPuns    #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes       #-}
{-# LANGUAGE RankNTypes        #-}
{-# LANGUAGE RecordWildCards   #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# 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                 (intercalate)
import qualified Data.List.NonEmpty        as NE
import qualified Data.Map                  as M
import           Data.Maybe                (fromMaybe)
import qualified Data.Text                 as T
import           Data.Tuple                (swap)
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, Text,
                                            (</>))
import           Turtle.Format             ((%))
import qualified Turtle.Format             as F

-------------------------------------------------------------------------------
--
-- * Utilities
--

#if !(MIN_VERSION_mtl(2,2,2))
liftEither :: MonadError e m => Either e a -> m a
liftEither = either throwError pure
#endif

-- | Like 'foldMap', but with an effectful projection.
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

-- | Like 'Control.Lens.Getter.Getting', but allows for retrieving the 'r'
-- element in some Applicative context 'm'.
type GettingM r s a = forall m. Applicative m => (a -> Compose m (Const r) a) -> s -> Compose m (Const r) s

-- | Given an effectful projection from 'a' into a monoid 'r', retrieve the sum
-- of all 'a' values in an 's' structure as targetted by the 'GettingM' optic.
-- Note that the Monoid constraint on 'r' is implicit via 'Const', but we
-- note it in the type for clarity.
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

-- $setup
-- >>> :set -XOverloadedStrings

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)

--------------------------------------------------------------------------------
--
-- * Reading files
--

-- | toModulePath takes an include-relative path to a .proto file and produces a
-- "module path" which is used during code generation.
--
-- Note that, with the exception of the '.proto' portion of the input filepath,
-- this function interprets '.' in the filename components as if they were
-- additional slashes (assuming that the '.' is not the first character, which
-- is merely ignored). So e.g. "google/protobuf/timestamp.proto" and
-- "google.protobuf.timestamp.proto" map to the same module path.
--
-- >>> toModulePath "/absolute/path/fails.proto"
-- Left "expected include-relative path"
--
-- >>> toModulePath "relative/path/to/file_without_proto_suffix_fails"
-- Left "expected .proto suffix"
--
-- >>> toModulePath "relative/path/to/file_without_proto_suffix_fails.txt"
-- Left "expected .proto suffix"
--
-- >>> toModulePath "../foo.proto"
-- Left "expected include-relative path, but the path started with ../"
--
-- >>> toModulePath "foo..proto"
-- Left "path contained unexpected .. after canonicalization, please use form x.y.z.proto"
--
-- >>> toModulePath "foo/bar/baz..proto"
-- Left "path contained unexpected .. after canonicalization, please use form x.y.z.proto"
--
-- >>> toModulePath "foo.bar../baz.proto"
-- Left "path contained unexpected .. after canonicalization, please use form x.y.z.proto"
--
-- >>> toModulePath "google/protobuf/timestamp.proto"
-- Right (Path {components = "Google" :| ["Protobuf","Timestamp"]})
--
-- >>> toModulePath "a/b/c/google.protobuf.timestamp.proto"
-- Right (Path {components = "A" :| ["B","C","Google","Protobuf","Timestamp"]})
--
-- >>> toModulePath "foo/FiLeName_underscore.and.then.some.dots.proto"
-- Right (Path {components = "Foo" :| ["FiLeName_underscore","And","Then","Some","Dots"]})
--
#if MIN_VERSION_turtle(1,6,0)
-- >>> toModulePath "foo/bar/././baz/../boggle.proto"
-- Left "path contained unexpected .. after canonicalization, please use form x.y.z.proto"
#else
-- >>> toModulePath "foo/bar/././baz/../boggle.proto"
-- Right (Path {components = "Foo" :| ["Bar","Boggle"]})
#endif
--
-- >>> toModulePath "./foo.proto"
-- Right (Path {components = "Foo" :| []})
--
-- NB: We ignore preceding single '.' characters
-- >>> toModulePath ".foo.proto"
-- Right (Path {components = "Foo" :| []})
toModulePath :: FilePath -> Either String Path
toModulePath :: FilePath -> Either FilePath 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
Turtle.stripPrefix FilePath
"./" -> FilePath
fp)
  | FilePath -> Bool
Turtle.absolute FilePath
fp
    = FilePath -> Either FilePath Path
forall a b. a -> Either a b
Left FilePath
"expected include-relative path"
  | FilePath -> Maybe FilePath
Turtle.extension FilePath
fp Maybe FilePath -> Maybe FilePath -> Bool
forall a. Eq a => a -> a -> Bool
/= FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
"proto"
    = FilePath -> Either FilePath Path
forall a b. a -> Either a b
Left FilePath
"expected .proto suffix"
  | Bool
otherwise
    = case FilePath -> FilePath -> Maybe FilePath
Turtle.stripPrefix FilePath
"../" FilePath
fp of
        Just{}  -> FilePath -> Either FilePath Path
forall a b. a -> Either a b
Left FilePath
"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
Turtle.collapse (FilePath -> Bool) -> FilePath -> Bool
forall a b. (a -> b) -> a -> b
$ FilePath
fp
            -> FilePath -> Either FilePath Path
forall a b. a -> Either a b
Left FilePath
"path contained unexpected .. after canonicalization, please use form x.y.z.proto"
          | Bool
otherwise
            -> Either FilePath Path
-> (NonEmpty FilePath -> Either FilePath Path)
-> Maybe (NonEmpty FilePath)
-> Either FilePath Path
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (FilePath -> Either FilePath Path
forall a b. a -> Either a b
Left FilePath
"empty path after canonicalization") (Path -> Either FilePath Path
forall a b. b -> Either a b
Right (Path -> Either FilePath Path)
-> (NonEmpty FilePath -> Path)
-> NonEmpty FilePath
-> Either FilePath Path
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty FilePath -> Path
Path)
             (Maybe (NonEmpty FilePath) -> Either FilePath Path)
-> (FilePath -> Maybe (NonEmpty FilePath))
-> FilePath
-> Either FilePath Path
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> Maybe (NonEmpty FilePath)
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty
             ([FilePath] -> Maybe (NonEmpty FilePath))
-> (FilePath -> [FilePath])
-> FilePath
-> Maybe (NonEmpty FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null -- Remove a potential preceding empty component which
                              -- arose from a preceding '.' in the input path, which we
                              -- want to ignore. E.g. ".foo.proto" => ["","Foo"].
             ([FilePath] -> [FilePath])
-> (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> FilePath) -> [Text] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> FilePath
T.unpack (Text -> FilePath) -> (Text -> Text) -> Text -> FilePath
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] -> [FilePath])
-> (FilePath -> [Text]) -> FilePath -> [FilePath]
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
Turtle.collapse
             (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
Turtle.dropExtension
             (FilePath -> Either FilePath Path)
-> FilePath -> Either FilePath Path
forall a b. (a -> b) -> a -> b
$ FilePath
fp

-- | @importProto searchPaths toplevel inc@ attempts to import include-relative
-- @inc@ after locating it somewhere in the @searchPaths@; @toplevel@ is simply
-- the path of toplevel .proto being processed so we can report it in an error
-- message. This function terminates the program if it cannot find the file to
-- import or if it cannot construct a valid module path from it.
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 FilePath
e
      -> Text -> m DotProto
forall (m :: * -> *) a. MonadIO m => Text -> m a
dieLines (FilePath -> FilePath -> Text
badModulePathErrorMsg FilePath
protoFP FilePath
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))

-- | Attempts to locate the first (if any) filename that exists on the given
-- search paths, and constructs the "module path" from the given
-- include-relative filename (2nd parameter). Terminates the program with an
-- error if the given pathname is not relative.
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 FilePath 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 FilePath 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)

-- * Pretty Error Messages

badModulePathErrorMsg :: FilePath -> String -> T.Text
badModulePathErrorMsg :: FilePath -> FilePath -> 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) (FilePath -> 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 context
--

-- | A mapping from .proto type identifiers to their type information
type TypeContext = M.Map DotProtoIdentifier DotProtoTypeInfo

-- | Information about messages and enumerations
data DotProtoTypeInfo = DotProtoTypeInfo
  { DotProtoTypeInfo -> DotProtoPackageSpec
dotProtoTypeInfoPackage    :: DotProtoPackageSpec
     -- ^ The package this type is defined in
  , DotProtoTypeInfo -> DotProtoIdentifier
dotProtoTypeInfoParent     :: DotProtoIdentifier
    -- ^ The message this type is nested under, or 'Anonymous' if it's top-level
  , DotProtoTypeInfo -> TypeContext
dotProtoTypeChildContext   :: TypeContext
    -- ^ The context that should be used for declarations within the
    --   scope of this type
  , DotProtoTypeInfo -> DotProtoKind
dotProtoTypeInfoKind       :: DotProtoKind
    -- ^ Whether this type is an enumeration or message
  , DotProtoTypeInfo -> Path
dotProtoTypeInfoModulePath :: Path
    -- ^ The include-relative module path used when importing this module
  } deriving Int -> DotProtoTypeInfo -> FilePath -> FilePath
[DotProtoTypeInfo] -> FilePath -> FilePath
DotProtoTypeInfo -> FilePath
(Int -> DotProtoTypeInfo -> FilePath -> FilePath)
-> (DotProtoTypeInfo -> FilePath)
-> ([DotProtoTypeInfo] -> FilePath -> FilePath)
-> Show DotProtoTypeInfo
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [DotProtoTypeInfo] -> FilePath -> FilePath
$cshowList :: [DotProtoTypeInfo] -> FilePath -> FilePath
show :: DotProtoTypeInfo -> FilePath
$cshow :: DotProtoTypeInfo -> FilePath
showsPrec :: Int -> DotProtoTypeInfo -> FilePath -> FilePath
$cshowsPrec :: Int -> DotProtoTypeInfo -> FilePath -> FilePath
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 })

-- | Whether a definition is an enumeration or a message
data DotProtoKind = DotProtoKindEnum
                  | DotProtoKindMessage
                  deriving (Int -> DotProtoKind -> FilePath -> FilePath
[DotProtoKind] -> FilePath -> FilePath
DotProtoKind -> FilePath
(Int -> DotProtoKind -> FilePath -> FilePath)
-> (DotProtoKind -> FilePath)
-> ([DotProtoKind] -> FilePath -> FilePath)
-> Show DotProtoKind
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [DotProtoKind] -> FilePath -> FilePath
$cshowList :: [DotProtoKind] -> FilePath -> FilePath
show :: DotProtoKind -> FilePath
$cshow :: DotProtoKind -> FilePath
showsPrec :: Int -> DotProtoKind -> FilePath -> FilePath
$cshowsPrec :: Int -> DotProtoKind -> FilePath -> FilePath
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)

-- ** Generating type contexts from ASTs

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 FilePath
_ 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 FilePath
_ 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)

boolOption :: String -> [DotProtoOption] -> Maybe Bool
boolOption :: FilePath -> [DotProtoOption] -> Maybe Bool
boolOption FilePath
desired [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
== FilePath -> DotProtoIdentifier
Single FilePath
desired) [DotProtoOption]
opts of
        Just (DotProtoOption DotProtoIdentifier
_ (BoolLit Bool
x)) -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
x
        Maybe DotProtoOption
_ -> Maybe Bool
forall a. Maybe a
Nothing

isPacked :: [DotProtoOption] -> Bool
isPacked :: [DotProtoOption] -> Bool
isPacked = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool)
-> ([DotProtoOption] -> Maybe Bool) -> [DotProtoOption] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [DotProtoOption] -> Maybe Bool
boolOption FilePath
"packed"

isUnpacked :: [DotProtoOption] -> Bool
isUnpacked :: [DotProtoOption] -> Bool
isUnpacked = Bool -> (Bool -> Bool) -> Maybe Bool -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False Bool -> Bool
not (Maybe Bool -> Bool)
-> ([DotProtoOption] -> Maybe Bool) -> [DotProtoOption] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [DotProtoOption] -> Maybe Bool
boolOption FilePath
"packed"

-- | Returns 'True' if the given primitive type is packable. The 'TypeContext'
-- is used to distinguish Named enums and messages, only the former of which are
-- packable.
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

--------------------------------------------------------------------------------
--
-- * Name resolution
--

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
_           ) -> FilePath -> m DotProtoIdentifier
forall (m :: * -> *) a.
MonadError CompileError m =>
FilePath -> m a
internalError FilePath
"concatDotProtoIdentifier: Qualified"
  (DotProtoIdentifier
_            , Qualified{}  ) -> FilePath -> m DotProtoIdentifier
forall (m :: * -> *) a.
MonadError CompileError m =>
FilePath -> m a
internalError FilePath
"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 FilePath
a     , DotProtoIdentifier
b            ) -> DotProtoIdentifier -> DotProtoIdentifier -> m DotProtoIdentifier
forall (m :: * -> *).
MonadError CompileError m =>
DotProtoIdentifier -> DotProtoIdentifier -> m DotProtoIdentifier
concatDotProtoIdentifier (Path -> DotProtoIdentifier
Dots (NonEmpty FilePath -> Path
Path (FilePath -> NonEmpty FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
a))) DotProtoIdentifier
b
  (DotProtoIdentifier
a            , Single FilePath
b     ) -> DotProtoIdentifier -> DotProtoIdentifier -> m DotProtoIdentifier
forall (m :: * -> *).
MonadError CompileError m =>
DotProtoIdentifier -> DotProtoIdentifier -> m DotProtoIdentifier
concatDotProtoIdentifier DotProtoIdentifier
a (Path -> DotProtoIdentifier
Dots (NonEmpty FilePath -> Path
Path (FilePath -> NonEmpty FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
b)))
  (Dots (Path NonEmpty FilePath
a), Dots (Path NonEmpty FilePath
b)) -> DotProtoIdentifier -> m DotProtoIdentifier
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Path -> DotProtoIdentifier
Dots (NonEmpty FilePath -> Path
Path (NonEmpty FilePath
a NonEmpty FilePath -> NonEmpty FilePath -> NonEmpty FilePath
forall a. Semigroup a => a -> a -> a
<> NonEmpty FilePath
b)))

-- | @'toPascalCase' xs'@ sends a snake-case string @xs@ to a pascal-cased string. Trailing underscores are not dropped
-- from the input string and exactly double underscores are replaced by a single underscore.
toPascalCase :: String -> String
toPascalCase :: FilePath -> FilePath
toPascalCase FilePath
xs = (Either FilePath FilePath -> FilePath)
-> [Either FilePath FilePath] -> FilePath
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Either FilePath FilePath -> FilePath
forall a. (Eq a, IsString a) => Either FilePath a -> FilePath
go ((Char -> Bool) -> FilePath -> [Either FilePath FilePath]
forall a. (a -> Bool) -> [a] -> [Either [a] [a]]
segmentBy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_') FilePath
xs)
  where
    go :: Either FilePath a -> FilePath
go (Left FilePath
seg) = FilePath -> FilePath
toUpperFirst FilePath
seg
    go (Right a
seg)
      | a
seg a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
"__" = FilePath
"_"
      | Bool
otherwise = FilePath
""

-- | @'toCamelCase' xs@ sends a snake-case string @xs@ to a camel-cased string.
toCamelCase :: String -> String
toCamelCase :: FilePath -> FilePath
toCamelCase FilePath
xs =
  case FilePath -> FilePath
toPascalCase FilePath
xs of
    FilePath
"" -> FilePath
""
    Char
x : FilePath
xs' -> Char -> Char
toLower Char
x Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: FilePath
xs'

-- | Uppercases the first character of a string.
--
-- ==== __Examples__
--
-- >>> toUpperFirst "abc"
-- "Abc"
--
-- >>> toUpperFirst ""
-- ""
toUpperFirst :: String -> String
toUpperFirst :: FilePath -> FilePath
toUpperFirst FilePath
"" = FilePath
""
toUpperFirst (Char
x : FilePath
xs) = Char -> Char
toUpper Char
x Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: FilePath
xs

-- | @'segmentBy' p xs@  partitions @xs@ into segments of @'Either' [a] [a]@
-- with:
--
-- * 'Right' sublists containing elements satisfying @p@, otherwise;
--
-- * 'Left' sublists containing elements that do not satisfy @p@
--
-- ==== __Examples__
--
-- >>> segmentBy (\c -> c == '_') "abc_123_xyz"
-- [Left "abc",Right "_",Left "123",Right "_",Left "xyz"]
segmentBy :: (a -> Bool) -> [a] -> [Either [a] [a]]
segmentBy :: (a -> Bool) -> [a] -> [Either [a] [a]]
segmentBy a -> Bool
p [a]
xs = case (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span a -> Bool
p [a]
xs of
  ([], []) -> []
  ([a]
ys, []) -> [[a] -> Either [a] [a]
forall a b. b -> Either a b
Right [a]
ys]
  ([], [a]
ys) -> [a] -> Either [a] [a]
forall a b. a -> Either a b
Left [a]
seg Either [a] [a] -> [Either [a] [a]] -> [Either [a] [a]]
forall a. a -> [a] -> [a]
: (a -> Bool) -> [a] -> [Either [a] [a]]
forall a. (a -> Bool) -> [a] -> [Either [a] [a]]
segmentBy a -> Bool
p [a]
ys'
    where
      ([a]
seg, [a]
ys') = (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break a -> Bool
p [a]
ys
  ([a]
xs', [a]
ys) -> [a] -> Either [a] [a]
forall a b. b -> Either a b
Right [a]
xs' Either [a] [a] -> [Either [a] [a]] -> [Either [a] [a]]
forall a. a -> [a] -> [a]
: [a] -> Either [a] [a]
forall a b. a -> Either a b
Left [a]
seg Either [a] [a] -> [Either [a] [a]] -> [Either [a] [a]]
forall a. a -> [a] -> [a]
: (a -> Bool) -> [a] -> [Either [a] [a]]
forall a. (a -> Bool) -> [a] -> [Either [a] [a]]
segmentBy a -> Bool
p [a]
ys'
    where
      ([a]
seg, [a]
ys') = (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break a -> Bool
p [a]
ys

-- | @'suffixBy' p xs@ yields @'Right' (xs', suf)@ if @suf@ is the longest suffix satisfying @p@ and @xs'@ is the rest
-- of the rest, otherwise the string is given back as @'Left' xs@ signifying @xs@ had no suffix satisfying @p@.
suffixBy :: forall a. (a -> Bool) -> [a] -> Either [a] ([a], [a])
suffixBy :: (a -> Bool) -> [a] -> Either [a] ([a], [a])
suffixBy a -> Bool
p [a]
xs' = do
  ([a]
pref, [a]
suf) <- (a -> Either [a] ([a], [a]) -> Either [a] ([a], [a]))
-> Either [a] ([a], [a]) -> [a] -> Either [a] ([a], [a])
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> Either [a] ([a], [a]) -> Either [a] ([a], [a])
go ([a] -> Either [a] ([a], [a])
forall a b. a -> Either a b
Left []) [a]
xs'
  if [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
suf
    then [a] -> Either [a] ([a], [a])
forall a b. a -> Either a b
Left [a]
pref
    else ([a], [a]) -> Either [a] ([a], [a])
forall (m :: * -> *) a. Monad m => a -> m a
return ([a]
pref, [a]
suf)
  where
    go :: a -> Either [a] ([a], [a]) -> Either [a] ([a], [a])
    go :: a -> Either [a] ([a], [a]) -> Either [a] ([a], [a])
go a
x (Right ([a]
xs, [a]
suf)) = ([a], [a]) -> Either [a] ([a], [a])
forall a b. b -> Either a b
Right (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs, [a]
suf)
    go a
x (Left [a]
xs)
      | a -> Bool
p a
x = [a] -> Either [a] ([a], [a])
forall a b. a -> Either a b
Left (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs)
      | Bool
otherwise = ([a], [a]) -> Either [a] ([a], [a])
forall a b. b -> Either a b
Right ([a
x], [a]
xs)

-- | @'typeLikeName' xs@ produces either the pascal-cased version of the string @xs@ if it begins with an alphabetical
-- character or underscore - which is replaced with 'X'. A 'CompileError' is emitted if the starting character is
-- non-alphabetic or if @xs == ""@.
typeLikeName :: MonadError CompileError m => String -> m String
typeLikeName :: FilePath -> m FilePath
typeLikeName FilePath
"" = FilePath -> m FilePath
forall (m :: * -> *) a.
MonadError CompileError m =>
FilePath -> m a
invalidTypeNameError FilePath
"<empty name>"
typeLikeName s :: FilePath
s@(Char
x : FilePath
xs)
  | Char -> Bool
isAlpha Char
x = FilePath -> m FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath -> m FilePath) -> FilePath -> m FilePath
forall a b. (a -> b) -> a -> b
$ case (Char -> Bool) -> FilePath -> Either FilePath (FilePath, FilePath)
forall a. (a -> Bool) -> [a] -> Either [a] ([a], [a])
suffixBy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_') FilePath
s of
      Left FilePath
xs' -> FilePath -> FilePath
invalidToCamelCase (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
toPascalCase FilePath
xs'
      Right (FilePath
xs', FilePath
suf) -> FilePath -> FilePath
invalidToCamelCase (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
toPascalCase FilePath
xs' FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
suf
  | Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' = FilePath -> m FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath -> m FilePath) -> FilePath -> m FilePath
forall a b. (a -> b) -> a -> b
$ case (Char -> Bool) -> FilePath -> Either FilePath (FilePath, FilePath)
forall a. (a -> Bool) -> [a] -> Either [a] ([a], [a])
suffixBy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_') FilePath
xs of
      Left FilePath
xs' -> FilePath -> FilePath
invalidToCamelCase (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ Char
'X' Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: FilePath -> FilePath
toPascalCase FilePath
xs'
      Right (FilePath
xs', FilePath
suf) -> FilePath -> FilePath
invalidToCamelCase (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ Char
'X' Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: (FilePath -> FilePath
toPascalCase FilePath
xs' FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
suf)
  | Bool
otherwise = FilePath -> m FilePath
forall (m :: * -> *) a.
MonadError CompileError m =>
FilePath -> m a
invalidTypeNameError FilePath
s
  where
    -- Transforms special characters that are not valid as a part of a Haskell name to CamelCase.
    -- For instance “foo-bar---baz” will become “FooBarBaz”.
    -- This function presumes that the first character of the initial value satisfies "isAlpha".
    -- This must be checked outside of this function.
    invalidToCamelCase :: FilePath -> FilePath
invalidToCamelCase FilePath
a =
      case (Char -> Bool) -> FilePath -> (FilePath, FilePath)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isValidNameChar FilePath
a of
        (FilePath
"", FilePath
"") -> FilePath
""
        (FilePath
"", FilePath
cs) -> FilePath -> FilePath
invalidToCamelCase (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isValidNameChar) (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
cs
        (Char
b : FilePath
bs, FilePath
cs) -> Char -> Char
toUpper Char
b Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: FilePath
bs FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> FilePath
invalidToCamelCase FilePath
cs

    -- Only valid as a secondary character.
    -- First character of a Haskell name can only be "isAlpha".
    isValidNameChar :: Char -> Bool
isValidNameChar Char
ch = Char -> Bool
isAlphaNum Char
ch Bool -> Bool -> Bool
|| Char
ch Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_'

-- | @'fieldLikeName' field@ is the casing transformation used to produce record selectors from message fields. If
-- @field@ is prefixed by a span of uppercase characters then that prefix will be lowercased while the remaining string
-- is left unchanged.
fieldLikeName :: String -> String
fieldLikeName :: FilePath -> FilePath
fieldLikeName FilePath
"" = FilePath
""
fieldLikeName (Char
x : FilePath
xs)
  | Char -> Bool
isUpper Char
x = (Char -> Char) -> FilePath -> FilePath
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower FilePath
prefix FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
suffix
  | Bool
otherwise = Char
x Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: FilePath
xs
  where (FilePath
prefix, FilePath
suffix) = (Char -> Bool) -> FilePath -> (FilePath, FilePath)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isUpper (Char
x Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: FilePath
xs)

prefixedEnumFieldName :: String -> String -> String
prefixedEnumFieldName :: FilePath -> FilePath -> FilePath
prefixedEnumFieldName FilePath
enumName FilePath
enumItem = FilePath
enumName FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
enumItem

prefixedConName :: MonadError CompileError m => String -> String -> m String
prefixedConName :: FilePath -> FilePath -> m FilePath
prefixedConName FilePath
msgName FilePath
conName = do
  FilePath
constructor <- FilePath -> m FilePath
forall (m :: * -> *).
MonadError CompileError m =>
FilePath -> m FilePath
typeLikeName FilePath
conName
  FilePath -> m FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
msgName FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
constructor)

-- | @'prefixedMethodName' service method@ produces a Haskell record selector name for the service method @method@ by
-- joining the names @service@, @method@ under concatenation on a camel-casing transformation.
prefixedMethodName :: MonadError CompileError m => String -> String -> m String
prefixedMethodName :: FilePath -> FilePath -> m FilePath
prefixedMethodName FilePath
_ FilePath
"" = FilePath -> m FilePath
forall (m :: * -> *) a.
MonadError CompileError m =>
FilePath -> m a
invalidTypeNameError FilePath
"<empty name>"
prefixedMethodName FilePath
serviceName (Char
x : FilePath
xs)
  | Char -> Bool
isLower Char
x = FilePath -> m FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> FilePath
fieldLikeName FilePath
serviceName FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
fieldLikeName (Char
x Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: FilePath
xs))
  | Bool
otherwise = do
      FilePath
method <- FilePath -> m FilePath
forall (m :: * -> *).
MonadError CompileError m =>
FilePath -> m FilePath
typeLikeName (Char
x Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: FilePath
xs)
      FilePath -> m FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> FilePath
fieldLikeName FilePath
serviceName FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
method)

-- | @'prefixedFieldName' prefix field@ constructs a Haskell record selector name by prepending @prefix@ in camel-case
-- to the message field/service method name @field@.
prefixedFieldName :: MonadError CompileError m => String -> String -> m String
prefixedFieldName :: FilePath -> FilePath -> m FilePath
prefixedFieldName FilePath
msgName FilePath
fieldName = do
  FilePath
field <- FilePath -> m FilePath
forall (m :: * -> *).
MonadError CompileError m =>
FilePath -> m FilePath
typeLikeName FilePath
fieldName
  FilePath -> m FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> FilePath
fieldLikeName FilePath
msgName FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
field)

dpIdentUnqualName :: MonadError CompileError m => DotProtoIdentifier -> m String
dpIdentUnqualName :: DotProtoIdentifier -> m FilePath
dpIdentUnqualName (Single FilePath
name)       = FilePath -> m FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
name
dpIdentUnqualName (Dots (Path NonEmpty FilePath
names)) = FilePath -> m FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NonEmpty FilePath -> FilePath
forall a. NonEmpty a -> a
NE.last NonEmpty FilePath
names)
dpIdentUnqualName (Qualified DotProtoIdentifier
_ DotProtoIdentifier
next)  = DotProtoIdentifier -> m FilePath
forall (m :: * -> *).
MonadError CompileError m =>
DotProtoIdentifier -> m FilePath
dpIdentUnqualName DotProtoIdentifier
next
dpIdentUnqualName DotProtoIdentifier
Anonymous           = FilePath -> m FilePath
forall (m :: * -> *) a.
MonadError CompileError m =>
FilePath -> m a
internalError FilePath
"dpIdentUnqualName: Anonymous"

dpIdentQualName :: MonadError CompileError m => DotProtoIdentifier -> m String
dpIdentQualName :: DotProtoIdentifier -> m FilePath
dpIdentQualName (Single FilePath
name)       = FilePath -> m FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
name
dpIdentQualName (Dots (Path NonEmpty FilePath
names)) = FilePath -> m FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate FilePath
"." (NonEmpty FilePath -> [FilePath]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty FilePath
names))
dpIdentQualName (Qualified DotProtoIdentifier
_ DotProtoIdentifier
_)     = FilePath -> m FilePath
forall (m :: * -> *) a.
MonadError CompileError m =>
FilePath -> m a
internalError FilePath
"dpIdentQualName: Qualified"
dpIdentQualName DotProtoIdentifier
Anonymous           = FilePath -> m FilePath
forall (m :: * -> *) a.
MonadError CompileError m =>
FilePath -> m a
internalError FilePath
"dpIdentQualName: Anonymous"

-- | Given a 'DotProtoIdentifier' for the parent type and the unqualified name
-- of this type, generate the corresponding Haskell name
nestedTypeName :: MonadError CompileError m => DotProtoIdentifier -> String -> m String
nestedTypeName :: DotProtoIdentifier -> FilePath -> m FilePath
nestedTypeName DotProtoIdentifier
Anonymous             FilePath
nm = FilePath -> m FilePath
forall (m :: * -> *).
MonadError CompileError m =>
FilePath -> m FilePath
typeLikeName FilePath
nm
nestedTypeName (Single FilePath
parent)       FilePath
nm = FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate FilePath
"_" ([FilePath] -> FilePath) -> m [FilePath] -> m FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FilePath -> m FilePath) -> [FilePath] -> m [FilePath]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse FilePath -> m FilePath
forall (m :: * -> *).
MonadError CompileError m =>
FilePath -> m FilePath
typeLikeName [FilePath
parent, FilePath
nm]
nestedTypeName (Dots (Path NonEmpty FilePath
parents)) FilePath
nm = FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate FilePath
"_" ([FilePath] -> FilePath)
-> ([FilePath] -> [FilePath]) -> [FilePath] -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([FilePath] -> [FilePath] -> [FilePath]
forall a. Semigroup a => a -> a -> a
<> [FilePath
nm]) ([FilePath] -> FilePath) -> m [FilePath] -> m FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FilePath -> m FilePath) -> [FilePath] -> m [FilePath]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse FilePath -> m FilePath
forall (m :: * -> *).
MonadError CompileError m =>
FilePath -> m FilePath
typeLikeName (NonEmpty FilePath -> [FilePath]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty FilePath
parents)
nestedTypeName (Qualified {})        FilePath
_  = FilePath -> m FilePath
forall (m :: * -> *) a.
MonadError CompileError m =>
FilePath -> m a
internalError FilePath
"nestedTypeName: Qualified"

qualifiedMessageName :: MonadError CompileError m => DotProtoIdentifier -> DotProtoIdentifier -> m String
qualifiedMessageName :: DotProtoIdentifier -> DotProtoIdentifier -> m FilePath
qualifiedMessageName DotProtoIdentifier
parentIdent DotProtoIdentifier
msgIdent = DotProtoIdentifier -> FilePath -> m FilePath
forall (m :: * -> *).
MonadError CompileError m =>
DotProtoIdentifier -> FilePath -> m FilePath
nestedTypeName DotProtoIdentifier
parentIdent (FilePath -> m FilePath) -> m FilePath -> m FilePath
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< DotProtoIdentifier -> m FilePath
forall (m :: * -> *).
MonadError CompileError m =>
DotProtoIdentifier -> m FilePath
dpIdentUnqualName DotProtoIdentifier
msgIdent

qualifiedMessageTypeName :: MonadError CompileError m =>
                            TypeContext ->
                            DotProtoIdentifier ->
                            DotProtoIdentifier ->
                            m String
qualifiedMessageTypeName :: TypeContext
-> DotProtoIdentifier -> DotProtoIdentifier -> m FilePath
qualifiedMessageTypeName TypeContext
ctxt DotProtoIdentifier
parentIdent DotProtoIdentifier
msgIdent = do
  [FilePath]
xs <- DotProtoIdentifier -> [FilePath] -> m [FilePath]
forall (f :: * -> *).
MonadError CompileError f =>
DotProtoIdentifier -> [FilePath] -> f [FilePath]
parents DotProtoIdentifier
parentIdent []
  case [FilePath]
xs of
    [] -> DotProtoIdentifier -> FilePath -> m FilePath
forall (m :: * -> *).
MonadError CompileError m =>
DotProtoIdentifier -> FilePath -> m FilePath
nestedTypeName DotProtoIdentifier
parentIdent (FilePath -> m FilePath) -> m FilePath -> m FilePath
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< DotProtoIdentifier -> m FilePath
forall (m :: * -> *).
MonadError CompileError m =>
DotProtoIdentifier -> m FilePath
dpIdentUnqualName DotProtoIdentifier
msgIdent
    FilePath
x : [FilePath]
xs' -> DotProtoIdentifier -> FilePath -> m FilePath
forall (m :: * -> *).
MonadError CompileError m =>
DotProtoIdentifier -> FilePath -> m FilePath
nestedTypeName (Path -> DotProtoIdentifier
Dots (Path -> DotProtoIdentifier)
-> (NonEmpty FilePath -> Path)
-> NonEmpty FilePath
-> DotProtoIdentifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty FilePath -> Path
Path (NonEmpty FilePath -> DotProtoIdentifier)
-> NonEmpty FilePath -> DotProtoIdentifier
forall a b. (a -> b) -> a -> b
$ FilePath
x FilePath -> [FilePath] -> NonEmpty FilePath
forall a. a -> [a] -> NonEmpty a
NE.:| [FilePath]
xs') (FilePath -> m FilePath) -> m FilePath -> m FilePath
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< DotProtoIdentifier -> m FilePath
forall (m :: * -> *).
MonadError CompileError m =>
DotProtoIdentifier -> m FilePath
dpIdentUnqualName DotProtoIdentifier
msgIdent
  where
    parents :: DotProtoIdentifier -> [FilePath] -> f [FilePath]
parents par :: DotProtoIdentifier
par@(Single FilePath
x) [FilePath]
xs =
      case DotProtoIdentifier -> TypeContext -> Maybe DotProtoTypeInfo
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup DotProtoIdentifier
par TypeContext
ctxt of
        Just (DotProtoTypeInfo { dotProtoTypeInfoParent :: DotProtoTypeInfo -> DotProtoIdentifier
dotProtoTypeInfoParent = DotProtoIdentifier
parentIdent' }) ->
          DotProtoIdentifier -> [FilePath] -> f [FilePath]
parents DotProtoIdentifier
parentIdent' ([FilePath] -> f [FilePath]) -> [FilePath] -> f [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath
x FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath]
xs
        Maybe DotProtoTypeInfo
Nothing ->
          [FilePath] -> f [FilePath]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([FilePath] -> f [FilePath]) -> [FilePath] -> f [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath
x FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath]
xs
    parents DotProtoIdentifier
Anonymous [FilePath]
xs =
      [FilePath] -> f [FilePath]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [FilePath]
xs
    parents DotProtoIdentifier
par [FilePath]
_ =
      FilePath -> f [FilePath]
forall (m :: * -> *) a.
MonadError CompileError m =>
FilePath -> m a
internalError (FilePath -> f [FilePath]) -> FilePath -> f [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath
"qualifiedMessageTypeName: wrong parent " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> DotProtoIdentifier -> FilePath
forall a. Show a => a -> FilePath
show DotProtoIdentifier
par

--------------------------------------------------------------------------------
--
-- ** Codegen bookkeeping helpers
--

-- | Bookeeping for qualified fields
data QualifiedField = QualifiedField
  { QualifiedField -> FieldName
recordFieldName :: FieldName
  , QualifiedField -> FieldInfo
fieldInfo       :: FieldInfo
  } deriving Int -> QualifiedField -> FilePath -> FilePath
[QualifiedField] -> FilePath -> FilePath
QualifiedField -> FilePath
(Int -> QualifiedField -> FilePath -> FilePath)
-> (QualifiedField -> FilePath)
-> ([QualifiedField] -> FilePath -> FilePath)
-> Show QualifiedField
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [QualifiedField] -> FilePath -> FilePath
$cshowList :: [QualifiedField] -> FilePath -> FilePath
show :: QualifiedField -> FilePath
$cshow :: QualifiedField -> FilePath
showsPrec :: Int -> QualifiedField -> FilePath -> FilePath
$cshowsPrec :: Int -> QualifiedField -> FilePath -> FilePath
Show

-- | Bookkeeping for fields
data FieldInfo
  = FieldOneOf OneofField
  | FieldNormal FieldName FieldNumber DotProtoType [DotProtoOption]
  deriving Int -> FieldInfo -> FilePath -> FilePath
[FieldInfo] -> FilePath -> FilePath
FieldInfo -> FilePath
(Int -> FieldInfo -> FilePath -> FilePath)
-> (FieldInfo -> FilePath)
-> ([FieldInfo] -> FilePath -> FilePath)
-> Show FieldInfo
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [FieldInfo] -> FilePath -> FilePath
$cshowList :: [FieldInfo] -> FilePath -> FilePath
show :: FieldInfo -> FilePath
$cshow :: FieldInfo -> FilePath
showsPrec :: Int -> FieldInfo -> FilePath -> FilePath
$cshowsPrec :: Int -> FieldInfo -> FilePath -> FilePath
Show

-- | Bookkeeping for oneof fields
data OneofField = OneofField
  { OneofField -> FilePath
oneofType :: String
  , OneofField -> [OneofSubfield]
subfields :: [OneofSubfield]
  } deriving Int -> OneofField -> FilePath -> FilePath
[OneofField] -> FilePath -> FilePath
OneofField -> FilePath
(Int -> OneofField -> FilePath -> FilePath)
-> (OneofField -> FilePath)
-> ([OneofField] -> FilePath -> FilePath)
-> Show OneofField
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [OneofField] -> FilePath -> FilePath
$cshowList :: [OneofField] -> FilePath -> FilePath
show :: OneofField -> FilePath
$cshow :: OneofField -> FilePath
showsPrec :: Int -> OneofField -> FilePath -> FilePath
$cshowsPrec :: Int -> OneofField -> FilePath -> FilePath
Show

-- | Bookkeeping for oneof subfields
data OneofSubfield = OneofSubfield
  { OneofSubfield -> FieldNumber
subfieldNumber   :: FieldNumber
  , OneofSubfield -> FilePath
subfieldConsName :: String
  , OneofSubfield -> FieldName
subfieldName     :: FieldName
  , OneofSubfield -> DotProtoType
subfieldType     :: DotProtoType
  , OneofSubfield -> [DotProtoOption]
subfieldOptions  :: [DotProtoOption]
  } deriving Int -> OneofSubfield -> FilePath -> FilePath
[OneofSubfield] -> FilePath -> FilePath
OneofSubfield -> FilePath
(Int -> OneofSubfield -> FilePath -> FilePath)
-> (OneofSubfield -> FilePath)
-> ([OneofSubfield] -> FilePath -> FilePath)
-> Show OneofSubfield
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [OneofSubfield] -> FilePath -> FilePath
$cshowList :: [OneofSubfield] -> FilePath -> FilePath
show :: OneofSubfield -> FilePath
$cshow :: OneofSubfield -> FilePath
showsPrec :: Int -> OneofSubfield -> FilePath -> FilePath
$cshowsPrec :: Int -> OneofSubfield -> FilePath -> FilePath
Show

getQualifiedFields :: MonadError CompileError m
                   => String -> [DotProtoMessagePart] -> m [QualifiedField]
getQualifiedFields :: FilePath -> [DotProtoMessagePart] -> m [QualifiedField]
getQualifiedFields FilePath
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{FilePath
[DotProtoOption]
FieldNumber
DotProtoType
DotProtoIdentifier
dotProtoFieldComment :: DotProtoField -> FilePath
dotProtoFieldOptions :: DotProtoField -> [DotProtoOption]
dotProtoFieldName :: DotProtoField -> DotProtoIdentifier
dotProtoFieldType :: DotProtoField -> DotProtoType
dotProtoFieldNumber :: DotProtoField -> FieldNumber
dotProtoFieldComment :: FilePath
dotProtoFieldOptions :: [DotProtoOption]
dotProtoFieldName :: DotProtoIdentifier
dotProtoFieldType :: DotProtoType
dotProtoFieldNumber :: FieldNumber
..} -> do
    FilePath
fieldName <- DotProtoIdentifier -> m FilePath
forall (m :: * -> *).
MonadError CompileError m =>
DotProtoIdentifier -> m FilePath
dpIdentUnqualName DotProtoIdentifier
dotProtoFieldName
    FilePath
qualName <- FilePath -> FilePath -> m FilePath
forall (m :: * -> *).
MonadError CompileError m =>
FilePath -> FilePath -> m FilePath
prefixedFieldName FilePath
msgName FilePath
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 = FilePath -> FieldName
coerce FilePath
qualName
                                  , fieldInfo :: FieldInfo
fieldInfo = FieldName
-> FieldNumber -> DotProtoType -> [DotProtoOption] -> FieldInfo
FieldNormal (FilePath -> FieldName
coerce FilePath
fieldName)
                                                            FieldNumber
dotProtoFieldNumber
                                                            DotProtoType
dotProtoFieldType
                                                            [DotProtoOption]
dotProtoFieldOptions
                                  }

  DotProtoMessageOneOf DotProtoIdentifier
_ [] ->
    CompileError -> m [QualifiedField]
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (FilePath -> CompileError
InternalError FilePath
"getQualifiedFields: encountered oneof with no oneof fields")

  DotProtoMessageOneOf DotProtoIdentifier
oneofIdent [DotProtoField]
fields -> do
    FilePath
ident <- DotProtoIdentifier -> m FilePath
forall (m :: * -> *).
MonadError CompileError m =>
DotProtoIdentifier -> m FilePath
dpIdentUnqualName DotProtoIdentifier
oneofIdent
    FilePath
oneofName <- FilePath -> FilePath -> m FilePath
forall (m :: * -> *).
MonadError CompileError m =>
FilePath -> FilePath -> m FilePath
prefixedFieldName FilePath
msgName FilePath
ident
    FilePath
oneofTypeName <- FilePath -> FilePath -> m FilePath
forall (m :: * -> *).
MonadError CompileError m =>
FilePath -> FilePath -> m FilePath
prefixedConName FilePath
msgName FilePath
ident

    let mkSubfield :: DotProtoField -> m [OneofSubfield]
mkSubfield DotProtoField{FilePath
[DotProtoOption]
FieldNumber
DotProtoType
DotProtoIdentifier
dotProtoFieldComment :: FilePath
dotProtoFieldOptions :: [DotProtoOption]
dotProtoFieldName :: DotProtoIdentifier
dotProtoFieldType :: DotProtoType
dotProtoFieldNumber :: FieldNumber
dotProtoFieldComment :: DotProtoField -> FilePath
dotProtoFieldOptions :: DotProtoField -> [DotProtoOption]
dotProtoFieldName :: DotProtoField -> DotProtoIdentifier
dotProtoFieldType :: DotProtoField -> DotProtoType
dotProtoFieldNumber :: DotProtoField -> FieldNumber
..} = do
            FilePath
s <- DotProtoIdentifier -> m FilePath
forall (m :: * -> *).
MonadError CompileError m =>
DotProtoIdentifier -> m FilePath
dpIdentUnqualName DotProtoIdentifier
dotProtoFieldName
            FilePath
c <- FilePath -> FilePath -> m FilePath
forall (m :: * -> *).
MonadError CompileError m =>
FilePath -> FilePath -> m FilePath
prefixedConName FilePath
oneofTypeName FilePath
s
            [OneofSubfield] -> m [OneofSubfield]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [FieldNumber
-> FilePath
-> FieldName
-> DotProtoType
-> [DotProtoOption]
-> OneofSubfield
OneofSubfield FieldNumber
dotProtoFieldNumber FilePath
c (FilePath -> FieldName
coerce FilePath
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 = FilePath -> FieldName
coerce FilePath
oneofName
                                  , fieldInfo :: FieldInfo
fieldInfo = OneofField -> FieldInfo
FieldOneOf (FilePath -> [OneofSubfield] -> OneofField
OneofField FilePath
ident [OneofSubfield]
fieldElems)
                                  }
  DotProtoMessagePart
_ -> [QualifiedField] -> m [QualifiedField]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

-- | Project qualified fields, given a projection function per field type.
foldQF :: (FieldName -> FieldNumber -> a) -- ^ projection for normal fields
       -> (OneofField -> a)               -- ^ projection for oneof fields
       -> 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 -> FilePath
fieldBinder = (FilePath
"f" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++) (FilePath -> FilePath)
-> (FieldNumber -> FilePath) -> FieldNumber -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldNumber -> FilePath
forall a. Show a => a -> FilePath
show

oneofSubBinder :: OneofSubfield -> String
oneofSubBinder :: OneofSubfield -> FilePath
oneofSubBinder = FieldNumber -> FilePath
fieldBinder (FieldNumber -> FilePath)
-> (OneofSubfield -> FieldNumber) -> OneofSubfield -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OneofSubfield -> FieldNumber
subfieldNumber

oneofSubDisjunctBinder :: [OneofSubfield] -> String
oneofSubDisjunctBinder :: [OneofSubfield] -> FilePath
oneofSubDisjunctBinder = FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate FilePath
"_or_" ([FilePath] -> FilePath)
-> ([OneofSubfield] -> [FilePath]) -> [OneofSubfield] -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (OneofSubfield -> FilePath) -> [OneofSubfield] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap OneofSubfield -> FilePath
oneofSubBinder

--------------------------------------------------------------------------------
--
-- * Errors
--

data CompileError
  = CircularImport FilePath
  | CompileParseError ParseError
  | InternalError String
  | InvalidPackageName DotProtoIdentifier
  | InvalidMethodName DotProtoIdentifier
  | InvalidModuleName String
  | InvalidTypeName String
  | InvalidMapKeyType String
  | NoPackageDeclaration
  | NoSuchType DotProtoIdentifier
  | NonzeroFirstEnumeration String DotProtoIdentifier Int32
  | EmptyEnumeration String
  | Unimplemented String
  deriving (Int -> CompileError -> FilePath -> FilePath
[CompileError] -> FilePath -> FilePath
CompileError -> FilePath
(Int -> CompileError -> FilePath -> FilePath)
-> (CompileError -> FilePath)
-> ([CompileError] -> FilePath -> FilePath)
-> Show CompileError
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [CompileError] -> FilePath -> FilePath
$cshowList :: [CompileError] -> FilePath -> FilePath
show :: CompileError -> FilePath
$cshow :: CompileError -> FilePath
showsPrec :: Int -> CompileError -> FilePath -> FilePath
$cshowsPrec :: Int -> CompileError -> FilePath -> FilePath
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 :: FilePath -> m a
internalError = CompileError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (CompileError -> m a)
-> (FilePath -> CompileError) -> FilePath -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> CompileError
InternalError

invalidTypeNameError :: MonadError CompileError m => String -> m a
invalidTypeNameError :: FilePath -> m a
invalidTypeNameError = CompileError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (CompileError -> m a)
-> (FilePath -> CompileError) -> FilePath -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> CompileError
InvalidTypeName

_unimplementedError :: MonadError CompileError m => String -> m a
_unimplementedError :: FilePath -> m a
_unimplementedError = CompileError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (CompileError -> m a)
-> (FilePath -> CompileError) -> FilePath -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> 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