hprotoc 2.0.11 → 2.0.12
raw patch · 4 files changed
+71/−37 lines, 4 filesdep ~protocol-buffersdep ~protocol-buffers-descriptor
Dependency ranges changed: protocol-buffers, protocol-buffers-descriptor
Files
- Text/ProtocolBuffers/ProtoCompile/MakeReflections.hs +5/−1
- Text/ProtocolBuffers/ProtoCompile/Resolve.hs +52/−22
- dist/build/hprotoc/hprotoc-tmp/Text/ProtocolBuffers/ProtoCompile/Lexer.hs +9/−9
- hprotoc.cabal +5/−5
Text/ProtocolBuffers/ProtoCompile/MakeReflections.hs view
@@ -40,7 +40,7 @@ import Text.ProtocolBuffers.Identifiers import Text.ProtocolBuffers.Reflections import Text.ProtocolBuffers.WireMessage(size'WireTag,toWireTag,toPackedWireTag,runPut,Wire(..))-import Text.ProtocolBuffers.ProtoCompile.Resolve(ReMap,NameMap(..),PackageID(..))+import Text.ProtocolBuffers.ProtoCompile.Resolve(ReMap,NameMap(..),getPackageID) import qualified Data.Foldable as F(foldr,toList) import qualified Data.Sequence as Seq(fromList,empty,singleton,null)@@ -124,6 +124,10 @@ keyExtendee' reMap f = case D.FieldDescriptorProto.extendee f of Nothing -> imp $ "keyExtendee expected Just but found Nothing: "++show f Just extName -> toHaskell reMap (FIName extName)+ -- let debugMsg = unlines [ "MakeReflections.keyExtendee'.debugMsg"+ -- , "extName is " ++ show extName+ -- , "reMap is :"+ -- , show reMap ] makeDescriptorInfo' :: ReMap -> FIName Utf8 -> (ProtoName -> Seq FieldInfo)
Text/ProtocolBuffers/ProtoCompile/Resolve.hs view
@@ -95,7 +95,7 @@ -- -- hprotoc will actually resolve more unqualified imported names than Google's protoc which requires -- more qualified names. I do not have the obsessive nature to fix this.-module Text.ProtocolBuffers.ProtoCompile.Resolve(loadProto,loadCodeGenRequest,makeNameMap,makeNameMaps,getTLS+module Text.ProtocolBuffers.ProtoCompile.Resolve(loadProto,loadCodeGenRequest,makeNameMaps,getTLS,getPackageID ,Env(..),TopLevel(..),ReMap,NameMap(..),PackageID(..),LocalFP(..),CanonFP(..)) where import qualified Text.DescriptorProtos.DescriptorProto as D(DescriptorProto)@@ -170,6 +170,8 @@ import qualified Data.Set as Set import qualified Data.Traversable as T +--import Debug.Trace(trace)+ -- Used by err and throw indent :: String -> String indent = unlines . map (\str -> ' ':' ':str) . lines@@ -202,14 +204,19 @@ -- change this to track the additional complexity. --newtype PackageID a = PackageID { getPackageID :: a } deriving (Show) -data PackageID a = PackageID { getPackageID :: a }- | NoPackageID { getPackageID :: a }+data PackageID a = PackageID { _getPackageID :: a }+ | NoPackageID { _getNoPackageID :: a } deriving (Show) -mPackageID :: Monoid a => PackageID a -> a-mPackageID (PackageID {getPackageID=x}) = x-mPackageID (NoPackageID {}) = mempty+instance Functor PackageID where+ fmap f (PackageID a) = PackageID (f a)+ fmap f (NoPackageID a) = NoPackageID (f a) +-- Used in MakeReflections.makeProtoInfo+getPackageID :: PackageID a -> a+getPackageID (PackageID a) = a+getPackageID (NoPackageID a) = a+ -- The package field of FileDescriptorProto is set in Parser.hs. -- 'getPackage' is the only direct user of this information in hprotoc. -- The convertFileToPackage was developed looking at the Java output of Google's protoc.@@ -224,12 +231,14 @@ Nothing -> NoPackageID defaultPackageName Just name -> NoPackageID name -getPackageUtf8 :: PackageID Utf8 -> Utf8-getPackageUtf8 (PackageID {getPackageID=x}) = x-getPackageUtf8 (NoPackageID {getPackageID=x}) = x+--getPackageUtf8 :: PackageID Utf8 -> Utf8+--getPackageUtf8 (PackageID {_getPackageID=x}) = x+--getPackageUtf8 (NoPackageID {_getNoPackageID=x}) = x -checkPackageID :: PackageID Utf8 -> Either String (Bool,[IName Utf8])-checkPackageID = checkDIUtf8 . getPackageUtf8+-- LOSES PackageID vs NoPackageID 2012-09-19+checkPackageID :: PackageID Utf8 -> Either String (PackageID (Bool,[IName Utf8]))+checkPackageID (PackageID a) = fmap PackageID (checkDIUtf8 a)+checkPackageID (NoPackageID a) = fmap NoPackageID (checkDIUtf8 a) -- | 'convertFileToPackage' mimics what I observe protoc --java_out do to convert the file name to a -- class name.@@ -356,11 +365,10 @@ , [MName String] -- hPrefix from command line , [MName String]) -- hParent from java_outer_classname, java_package, or 'getPackage' ReMap+ deriving (Show) type RE a = ReaderT Env (Either ErrStr) a -get'SEnv'root'from'PackageID :: PackageID [IName String] -> [IName String]-get'SEnv'root'from'PackageID = mPackageID data SEnv = SEnv { my'Parent :: [IName String] -- top level value is derived from PackageID , my'Env :: Env }@@ -459,13 +467,13 @@ (if matchesMain main (top'Package tl) then filteredLookup (top'mVals tl) xs else Nothing) <|> (matchPrefix (top'Package tl) xs >>= filteredLookup (top'mVals tl))- where matchesMain (PackageID {getPackageID=a}) (PackageID {getPackageID=b}) = a==b- matchesMain (NoPackageID {}) (PackageID {}) = False+ where matchesMain (PackageID {_getPackageID=a}) (PackageID {_getPackageID=b}) = a==b+ matchesMain (NoPackageID {}) (PackageID {}) = False -- XXX XXX XXX 2012-09-19 suspicious matchesMain (PackageID {}) (NoPackageID {}) = True matchesMain (NoPackageID {}) (NoPackageID {}) = True matchPrefix (NoPackageID {}) _ = Nothing- matchPrefix (PackageID {getPackageID=a}) ys = stripPrefix a ys+ matchPrefix (PackageID {_getPackageID=a}) ys = stripPrefix a ys filteredLookup valsIn namesIn = let lookupVals :: EMap -> [IName String] -> Maybe E'Entity@@ -520,8 +528,8 @@ -- WAS whereEnv (Global tl _) = fiName (joinDot (getPackageID (top'Package tl))) ++ " in " ++ show (top'Path tl) whereEnv (Global tl _) = formatPackageID ++ " in " ++ show (top'Path tl) where formatPackageID = case top'Package tl of- PackageID {getPackageID=x} -> fiName (joinDot x)- NoPackageID {getPackageID=y} -> show y+ PackageID {_getPackageID=x} -> fiName (joinDot x)+ NoPackageID {_getNoPackageID=y} -> show y -- | 'partEither' separates the Left errors and Right success in the obvious way. partEither :: [Either a b] -> ([a],[b])@@ -589,7 +597,9 @@ (NameMap tuple m) <- makeNameMap (getPrefix fdp) fdp let f (NameMap _ x) = x ms <- fmap (map f) . mapM (\y -> makeNameMap (getPrefix y) y) $ fdps- return (NameMap tuple (M.unions (m:ms)))+ let nameMap = (NameMap tuple (M.unions (m:ms)))+-- trace (show nameMap) $ + return nameMap -- | 'makeNameMap' conservatively checks its input. makeNameMap :: [MName String] -> D.FileDescriptorProto -> Either ErrStr NameMap@@ -606,11 +616,13 @@ Nothing -> FIName $ fromString "" Just p -> difi $ DIName p -}- let packageName@(PackageID fi'package'name) = PackageID (difi (DIName (getPackageUtf8 rawPackage))) :: PackageID (FIName Utf8)+ let packageName :: PackageID (FIName Utf8)+ packageName = fmap (difi . DIName) rawPackage+ fi'package'name = getPackageID packageName rawParent <- getJust "makeNameMap.makeOne: impossible Nothing found" . msum $ [ D.FileOptions.java_outer_classname =<< (D.FileDescriptorProto.options fdp) , D.FileOptions.java_package =<< (D.FileDescriptorProto.options fdp)- , Just (getPackageUtf8 rawPackage)]+ , Just (getPackageID rawPackage)] diParent <- getJust ("makeNameMap.makeOne: invalid character in: "++show rawParent) (validDI rawParent) let hParent = map (mangle :: IName Utf8 -> MName String) . splitDI $ diParent@@ -677,6 +689,7 @@ -- The 'mdo' usage has been replace by modified forms of 'mfix' that will generate useful error -- values instead of calling 'error' and halting 'hprotoc'. --+-- Used from loadProto' makeTopLevel :: D.FileDescriptorProto -> PackageID [IName String] -> [TopLevel] -> Either ErrStr Env {- Global -} makeTopLevel fdp packageName imports = do filePath <- getJust "makeTopLevel.filePath" (D.FileDescriptorProto.name fdp)@@ -713,7 +726,16 @@ where runRE :: Env -> RE D.FileDescriptorProto -> Either ErrStr D.FileDescriptorProto runRE envIn m = runReaderT m envIn + -- Used from makeTopLevel, from loadProto'+ get'SEnv'root'from'PackageID :: PackageID [IName String] -> [IName String]+ get'SEnv'root'from'PackageID = getPackageID -- was mPackageID before 2012-09-19+ -- where+ -- Used from get'SEnv makeTopLevel, from loadProto'+ -- mPackageID :: Monoid a => PackageID a -> a+ -- mPackageID (PackageID {_getPackageID=x}) = x+ -- mPackageID (NoPackageID {}) = mempty + -- Copies of mFix for use the string in (Left msg) for the error message. -- Note that the usual mfix for Either calls 'error' while this does not, -- it uses a default value passed to myFix*.@@ -1295,8 +1317,16 @@ (parsed'fdp, canonicalFile) <- lift $ fdpReader file let rawPackage = getPackage parsed'fdp packageName <- either (loadFailed canonicalFile . show)- (return . PackageID . map iToString . snd)+ (return . fmap (map iToString . snd)) -- 2012-09-19 suspicious (checkPackageID rawPackage)++{-+-- OLD before 2012-09-19+ packageName <- either (loadFailed canonicalFile . show)+ (return . PackageID . map iToString . snd) -- 2012-09-19 suspicious+ (checkPackageID rawPackage)+-}+ {- -- previously patched solution packageName <- case D.FileDescriptorProto.package parsed'fdp of
dist/build/hprotoc/hprotoc-tmp/Text/ProtocolBuffers/ProtoCompile/Lexer.hs view
@@ -56,7 +56,7 @@ -- ----------------------------------------------------------------------------- -- The input type -{-# LINE 71 "templates/wrappers.hs" #-}+{-# LINE 72 "templates/wrappers.hs" #-} type AlexInput = (AlexPosn, -- current position,@@ -75,9 +75,9 @@ in p' `seq` cs' `seq` Just (b, (p', c, cs')) -{-# LINE 102 "templates/wrappers.hs" #-}+{-# LINE 103 "templates/wrappers.hs" #-} -{-# LINE 117 "templates/wrappers.hs" #-}+{-# LINE 118 "templates/wrappers.hs" #-} -- ----------------------------------------------------------------------------- -- Token positions@@ -105,27 +105,27 @@ -- ----------------------------------------------------------------------------- -- Default monad -{-# LINE 230 "templates/wrappers.hs" #-}+{-# LINE 231 "templates/wrappers.hs" #-} -- ----------------------------------------------------------------------------- -- Monad (with ByteString input) -{-# LINE 319 "templates/wrappers.hs" #-}+{-# LINE 320 "templates/wrappers.hs" #-} -- ----------------------------------------------------------------------------- -- Basic wrapper -{-# LINE 345 "templates/wrappers.hs" #-}+{-# LINE 346 "templates/wrappers.hs" #-} -- ----------------------------------------------------------------------------- -- Basic wrapper, ByteString version -{-# LINE 363 "templates/wrappers.hs" #-}+{-# LINE 364 "templates/wrappers.hs" #-} -{-# LINE 376 "templates/wrappers.hs" #-}+{-# LINE 377 "templates/wrappers.hs" #-} -- -----------------------------------------------------------------------------@@ -133,7 +133,7 @@ -- Adds text positions to the basic model. -{-# LINE 393 "templates/wrappers.hs" #-}+{-# LINE 394 "templates/wrappers.hs" #-} -- -----------------------------------------------------------------------------
hprotoc.cabal view
@@ -1,5 +1,5 @@ name: hprotoc-version: 2.0.11+version: 2.0.12 cabal-version: >= 1.6 build-type: Simple license: BSD3@@ -8,8 +8,8 @@ author: Christopher Edward Kuklewicz maintainer: Chris Kuklewicz <protobuf@personal.mightyreason.com> stability: Experimental-homepage: http://hackage.haskell.org/package/hprotoc-package-url: http://code.haskell.org/protocol-buffers/+homepage: http://code.haskell.org/protocol-buffers/+package-url: http://hackage.haskell.org/package/hprotoc synopsis: Parse Google Protocol Buffer specifications description: Parse language defined at "http://code.google.com/apis/protocolbuffers/docs/proto.html" and general haskell code to implement messages. category: Text@@ -22,8 +22,8 @@ description: Choose the new smaller, split-up base package. Executable hprotoc- build-depends: protocol-buffers == 2.0.11,- protocol-buffers-descriptor == 2.0.11+ build-depends: protocol-buffers == 2.0.12,+ protocol-buffers-descriptor == 2.0.12 Main-Is: Text/ProtocolBuffers/ProtoCompile.hs Hs-Source-Dirs: ., protoc-gen-haskell