diff --git a/ChangeLog b/ChangeLog --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,5 @@ +2014-07-20 v0.7.2.6 + tokenise / basicTokenise moved to haskell-token-utils 2014-07-16 v0.7.2.5 Fix incompatibility with haskell-token-utils 0.0.0.3, closing issue #14 diff --git a/HaRe.cabal b/HaRe.cabal --- a/HaRe.cabal +++ b/HaRe.cabal @@ -1,5 +1,5 @@ Name: HaRe -Version: 0.7.2.5 +Version: 0.7.2.6 Author: Chris Brown, Huiqing Li, Simon Thompson, Alan Zimmerman Maintainer: Alan Zimmerman Stability: Alpha @@ -66,7 +66,7 @@ , Strafunski-StrategyLib , syz - , haskell-token-utils >= 0.0.0.3 + , haskell-token-utils >= 0.0.0.4 GHC-Options: -Wall diff --git a/src/Language/Haskell/Refact/API.hs b/src/Language/Haskell/Refact/API.hs --- a/src/Language/Haskell/Refact/API.hs +++ b/src/Language/Haskell/Refact/API.hs @@ -365,7 +365,7 @@ , prettyprint , prettyprint2 , ppType - , lexStringToRichTokens + , lexStringToTokens , getDataConstructors , setGhcContext @@ -373,6 +373,10 @@ , Positioning(..) , reIndentToks , ghcSrcSpanToForestSpan + + -- * Span conversion functions + , gs2f,f2gs + , gs2ss,ss2gs ) where import Language.Haskell.Refact.Utils.Binds @@ -389,4 +393,4 @@ import Language.Haskell.TokenUtils.Types import Language.Haskell.TokenUtils.TokenUtils import Language.Haskell.TokenUtils.Utils --- import Language.Haskell.TokenUtils.GHC.Layout +import Language.Haskell.TokenUtils.GHC.Layout diff --git a/src/Language/Haskell/Refact/Refactoring/Case.hs b/src/Language/Haskell/Refact/Refactoring/Case.hs --- a/src/Language/Haskell/Refact/Refactoring/Case.hs +++ b/src/Language/Haskell/Refact/Refactoring/Case.hs @@ -54,12 +54,15 @@ -- drawTokenTreeDetailed "reallyDoIfToCase" -- ++AZ++ debug newExp <- ifToCaseTransform exp1 - let (GHC.RealSrcLoc rl) = GHC.srcSpanStart l - caseTok <- liftIO $ tokenise rl 0 False "case" + -- let (GHC.RealSrcLoc rl) = GHC.srcSpanStart l + let caseTok = tokenise (gs2ss l) 0 False "case" condToks <- getToksForSpan l1 - ofTok <- liftIO $ tokenise (realSrcLocFromTok (glast "reallyDoIfToCase" condToks)) 1 True "of" - trueToks <- liftIO $ basicTokenise "True ->" - falseToks <- liftIO $ basicTokenise "False ->" + let ofTok = tokenise + (gs2ss $ tokenSrcSpan (glast "reallyDoIfToCase" condToks)) + -- (realSrcLocFromTok (glast "reallyDoIfToCase" condToks)) + 1 True "of" + let trueToks = basicTokenise "True ->" + let falseToks = basicTokenise "False ->" thenToksRaw <- getToksForSpan l2 elseToksRaw <- getToksForSpan l3 diff --git a/src/Language/Haskell/Refact/Refactoring/MoveDef.hs b/src/Language/Haskell/Refact/Refactoring/MoveDef.hs --- a/src/Language/Haskell/Refact/Refactoring/MoveDef.hs +++ b/src/Language/Haskell/Refact/Refactoring/MoveDef.hs @@ -819,7 +819,7 @@ newStr = ":: " ++ (intercalate " -> " $ map printSigComponent ts) ++ " -> " logm $ "addParamsToSigs:replaceSpan=" ++ showGhc replaceSpan logm $ "addParamsToSigs:newStr=[" ++ newStr ++ "]" - newToks <- liftIO $ basicTokenise newStr + let newToks = basicTokenise newStr void $ putToksForSpan replaceSpan newToks let typ' = foldl addOneType ltyp ts sigOk <- isNewSignatureOk ts diff --git a/src/Language/Haskell/Refact/Utils/GhcVersionSpecific.hs b/src/Language/Haskell/Refact/Utils/GhcVersionSpecific.hs --- a/src/Language/Haskell/Refact/Utils/GhcVersionSpecific.hs +++ b/src/Language/Haskell/Refact/Utils/GhcVersionSpecific.hs @@ -8,7 +8,7 @@ , prettyprint , prettyprint2 , ppType - , lexStringToRichTokens + -- , lexStringToRichTokens , getDataConstructors , setGhcContext ) @@ -65,7 +65,7 @@ -- --------------------------------------------------------------------- - +{- moved to haskell-token-utils lexStringToRichTokens :: GHC.RealSrcLoc -> String -> IO [PosToken] lexStringToRichTokens startLoc str = do -- error $ "lexStringToRichTokens: (startLoc,str)=" ++ (showGhc (startLoc,str)) -- ++AZ @@ -87,7 +87,7 @@ GHC.PFailed _srcSpan _msg -> error $ "lexStringToRichTokens:" -- ++ (show $ GHC.ppr msg) -- addSourceToTokens :: RealSrcLoc -> StringBuffer -> [Located Token] -> [(Located Token, String)] - +-} -- --------------------------------------------------------------------- diff --git a/src/Language/Haskell/Refact/Utils/LocUtils.hs b/src/Language/Haskell/Refact/Utils/LocUtils.hs --- a/src/Language/Haskell/Refact/Utils/LocUtils.hs +++ b/src/Language/Haskell/Refact/Utils/LocUtils.hs @@ -49,8 +49,8 @@ {-, prettyprint ,deleteFromToks, prettyprintGuardsAlt, -} - , tokenise - , basicTokenise + -- , tokenise + -- , basicTokenise -- , prettyprint -- , prettyprintGhc , prettyprintPatList , groupTokensByLine @@ -307,7 +307,7 @@ else s:replaceTabBySpaces ss -- --------------------------------------------------------------------- - +{- -- | Convert a string into a set of Haskell tokens, following the -- given position, with each line indented by a given column offset if -- required @@ -340,7 +340,7 @@ where -- startPos = (GHC.mkRealSrcLoc tokenFileMark 0 1) startPos = (GHC.mkRealSrcLoc (GHC.mkFastString "foo") 0 1) - +-} -- --------------------------------------------------------------------- --Should add cases for literals. diff --git a/src/Language/Haskell/Refact/Utils/MonadFunctions.hs b/src/Language/Haskell/Refact/Utils/MonadFunctions.hs --- a/src/Language/Haskell/Refact/Utils/MonadFunctions.hs +++ b/src/Language/Haskell/Refact/Utils/MonadFunctions.hs @@ -443,7 +443,7 @@ updateToks (GHC.L sspan _) newAST printFun addTrailingNl = do logm $ "updateToks " ++ (showGhc sspan) ++ ":" ++ (show (showSrcSpanF sspan)) - newToks <- liftIO $ basicTokenise (printFun newAST) + let newToks = basicTokenise (printFun newAST) let newToks' = if addTrailingNl then newToks ++ [newLnToken (last newToks)] else newToks @@ -461,7 +461,7 @@ updateToksWithPos (startPos,endPos) newAST printFun addTrailingNl = do -- newToks <- liftIO $ basicTokenise (printFun newAST) - newToks <- liftIO $ basicTokenise (printFun newAST) + let newToks = basicTokenise (printFun newAST) let newToks' = if addTrailingNl then newToks ++ [newLnToken (last newToks)] else newToks diff --git a/src/Language/Haskell/Refact/Utils/TypeUtils.hs b/src/Language/Haskell/Refact/Utils/TypeUtils.hs --- a/src/Language/Haskell/Refact/Utils/TypeUtils.hs +++ b/src/Language/Haskell/Refact/Utils/TypeUtils.hs @@ -2788,7 +2788,7 @@ let startPos = tokenPos lastTok let endPos = tokenPosEnd lastTok - newToks <- liftIO $ basicTokenise (showGhc impDecl) + let newToks = basicTokenise (showGhc impDecl) logm $ "addImportDecl:newToks=" ++ (show newToks) -- ++AZ++ void $ addToksAfterPos (startPos,endPos) (PlaceOffset 1 0 1) newToks return (groupedDecls, (imp++[(mkNewLSomething impDecl)]), b, c) @@ -2885,7 +2885,7 @@ Just _ts -> "" Nothing -> "\n" ++ (intercalate "\n" $ map prettyprint maybeSig) -- logm $ "makeNewToks:declStr=[" ++ declStr ++ "]" - newToks <- liftIO $ tokenise (realSrcLocFromTok mkZeroToken) 0 True (sigStr ++ declStr) + let newToks = tokenise ((0,0),(0,0)) 0 True (sigStr ++ declStr) return newToks -- --------------------------------------------------------------------- @@ -2978,7 +2978,7 @@ then getStartEndLoc parent' else getStartEndLoc localDecls - newToks <- liftIO $ basicTokenise newSource + let newToks = basicTokenise newSource (newFun',_) <- addLocInfo (newFun, newToks) @@ -3183,8 +3183,8 @@ let newStr = (prettyprintPatList prettyprint True newParams) case place of - Left l@(GHC.RealSrcSpan ss) -> do - newToks' <- liftIO $ tokenise (GHC.realSrcSpanStart ss) 0 False newStr + Left l@(GHC.RealSrcSpan _ss) -> do + let newToks' = tokenise (gs2ss l) 0 False newStr let newToks = map markToken newToks' _ <- addToksAfterSpan l PlaceAdjacent newToks return () @@ -3195,8 +3195,7 @@ toks <- getToksForSpan l let oldStr = GHC.showRichTokenStream $ rmOffsetFromToks toks - combinedToks <- liftIO $ tokenise (realSrcLocFromTok - $ ghead "addFormalParams" toks) + let combinedToks = tokenise (gs2ss $ tokenSrcSpan $ ghead "addFormalParams" toks) 0 False (newStr ++ " " ++ oldStr) _ <- putToksForSpan l combinedToks