[commit: packages/template-haskell] master: Improve mkName, so that it correctly parses the name ^.. (21a4860)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/template-haskell

On branch  : master
Link       : http://git.haskell.org/packages/template-haskell.git/commitdiff/21a48605d856ca334bb3a018e02255349d69a8c4

>---------------------------------------------------------------

commit 21a48605d856ca334bb3a018e02255349d69a8c4
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Sat Dec 28 11:05:31 2013 +0000

    Improve mkName, so that it correctly parses the name ^..
    
    This fixes Trac #8633; thanks to aavogt for a first draft.


>---------------------------------------------------------------

21a48605d856ca334bb3a018e02255349d69a8c4
 Language/Haskell/TH/Syntax.hs |   24 ++++++++++++++++++++----
 1 file changed, 20 insertions(+), 4 deletions(-)

diff --git a/Language/Haskell/TH/Syntax.hs b/Language/Haskell/TH/Syntax.hs
index f3868d1..3606f9d 100644
--- a/Language/Haskell/TH/Syntax.hs
+++ b/Language/Haskell/TH/Syntax.hs
@@ -24,7 +24,7 @@ import Data.IORef
 import System.IO.Unsafe	( unsafePerformIO )
 import Control.Monad (liftM)
 import System.IO	( hPutStrLn, stderr )
-import Data.Char        ( isAlpha )
+import Data.Char        ( isAlpha, isAlphaNum, isUpper )
 import Data.Word        ( Word8 )
 
 -----------------------------------------------------
@@ -758,17 +758,33 @@ mkName str
   = split [] (reverse str)
   where
     split occ []        = Name (mkOccName occ) NameS
-    split occ ('.':rev)	| not (null occ),
-			  not (null rev), head rev /= '.'
+    split occ ('.':rev)	| not (null occ)
+			, is_rev_mod_name rev
 			= Name (mkOccName occ) (NameQ (mkModName (reverse rev)))
 	-- The 'not (null occ)' guard ensures that
 	-- 	mkName "&." = Name "&." NameS
-	-- The 'rev' guards ensure that
+	-- The 'is_rev_mod' guards ensure that
 	--	mkName ".&" = Name ".&" NameS
+	--	mkName "^.." = Name "^.." NameS      -- Trac #8633
 	--	mkName "Data.Bits..&" = Name ".&" (NameQ "Data.Bits")
 	-- This rather bizarre case actually happened; (.&.) is in Data.Bits
     split occ (c:rev)   = split (c:occ) rev
 
+    -- Recognises a reversed module name xA.yB.C, 
+    -- with at least one component, 
+    -- and each component looks like a module name
+    --   (i.e. non-empty, starts with capital, all alpha)
+    is_rev_mod_name rev_mod_str
+      | (compt, rest) <- break (== '.') rev_mod_str
+      , not (null compt), isUpper (last compt), all is_mod_char compt
+      = case rest of
+          []             -> True
+          (_dot : rest') -> is_rev_mod_name rest'
+      | otherwise
+      = False
+
+    is_mod_char c = isAlphaNum c || c == '_' || c == '\''
+
 -- | Only used internally
 mkNameU :: String -> Uniq -> Name
 mkNameU s (I# u) = Name (mkOccName s) (NameU u)