pinned-warnings 0.1.0.4 → 0.1.0.5
raw patch · 3 files changed
+150/−19 lines, 3 filesdep ~bytestring
Dependency ranges changed: bytestring
Files
- pinned-warnings.cabal +5/−4
- src/Internal/FixWarnings.hs +28/−14
- test/Spec.hs +117/−1
pinned-warnings.cabal view
@@ -4,7 +4,7 @@ -- http://haskell.org/cabal/users-guide/ name: pinned-warnings-version: 0.1.0.4+version: 0.1.0.5 synopsis: Preserve warnings in a GHCi session description: Please see the README on GitHub at <https://github.com/aaronallen8455/pinned-warnings#readme> homepage: https://github.com/aaronallen8455/pinned-warnings#readme@@ -22,10 +22,10 @@ tested-with: GHC ==8.10.4 || ==9.0.1 library- exposed-modules: PinnedWarnings, ShowWarnings-- other-modules: Internal.GhcFacade+ exposed-modules: PinnedWarnings+ ShowWarnings Internal.FixWarnings+ Internal.GhcFacade Internal.Types build-depends: ghc >= 8.8 && < 9.1,@@ -48,4 +48,5 @@ pinned-warnings, tasty, tasty-hunit,+ bytestring default-language: Haskell2010
src/Internal/FixWarnings.hs view
@@ -3,6 +3,7 @@ module Internal.FixWarnings ( fixWarning , fixRedundancyWarning+ , RedundancyWarn(..) ) where import Control.Applicative ((<|>))@@ -136,33 +137,47 @@ fixRedundantThing stmt thing | (start, match) <- BS.breakSubstring thingBS stmt , not (BS.null match)- , isSeparator . BS.take 1 $ BS.drop thingLen match- , isCellStart . BS.take 1 $ BS.reverse start+ , isSeparator $ BS.drop thingLen match+ , isCellStart $ BS.reverse start - -- check that there isn't a second match+ -- check that there isn't a second valid match , (start2, match2) <- BS.breakSubstring thingBS (BS.drop thingLen match) , BS.null match2 || not- ( isSeparator (BS.take 1 $ BS.drop thingLen match2)- && isCellStart (BS.take 1 $ BS.reverse start2)+ ( isSeparator (BS.drop thingLen match2)+ && isCellStart (BS.reverse start2) ) - , let start' = BS.dropWhileEnd (\c -> c /= ',' && c /= '(') start+ -- preserve the whitespace immediately after the ',' or '('+ , let start' = let (s, e) = BS.breakEnd (`elem` [',', '(']) start+ in s <> BS.takeWhile isSpace e+ end = dropRest . BS.dropSpace $ BS.drop thingLen match - = case BS.take 1 end of- "," -> Just $ start' <> BS.drop 1 end- ")" -> Just $ BS.take (BS.length start' - 1) start' <> end- _ -> Nothing+ = BS.uncons end >>= \case+ (',', end') -> Just $ start' <> BS.dropSpace end'+ -- If bound on the right by ')', remove the suffix containing ',' from start+ (')', _) -> Just $ BS.init (BS.dropWhileEnd isSpace start') <> end+ _ -> Nothing | otherwise = Nothing where- thingBS = BS.pack thing+ thingBS | isOperator bs = "(" <> bs <> ")"+ | otherwise = bs+ where bs = BS.pack thing thingLen = BS.length thingBS- isSeparator c = BS.all isSpace c || c `elem` [",", "(", ")"]- isCellStart c = BS.all isSpace c || c `elem` [",", "("]++ isSeparator = headPred $ \c -> isSpace c || c `elem` [',', '(', ')']+ isCellStart = headPred $ \c -> isSpace c || c `elem` [',', '(']+ isOperator = headPred (`elem` opChars)+ where+ opChars :: String+ opChars = ":!#$%&*+./<=>?@\\^|-~"+ headPred :: (Char -> Bool) -> BS.ByteString -> Bool+ headPred p = maybe False (p . fst) . BS.uncons+ dropRest bs = case BS.uncons bs of Nothing -> "" -- Constructors of a type or methods of a class@@ -216,4 +231,3 @@ _ <- P.munch (const True) pure result-
test/Spec.hs view
@@ -1,2 +1,118 @@+{-# LANGUAGE OverloadedStrings #-}++import qualified Data.ByteString as BS+import Test.Tasty+import Test.Tasty.HUnit++import Internal.FixWarnings+ main :: IO ()-main = pure ()+main = defaultMain tests++tests :: TestTree+tests =+ testGroup "FixWarnings"+ [ testCase "Removes thing" $ do+ fixRedundancyWarning 1 (IndividualThings ["foo"]) [input1]+ @?= Just [output1]++ fixRedundancyWarning 1 (IndividualThings ["bar"]) [input2]+ @?= Just [output2]++ fixRedundancyWarning 1 (IndividualThings ["baz", "foo"]) [input3]+ @?= Just [output3]++ fixRedundancyWarning 1 (IndividualThings ["bar"]) [input4]+ @?= Just [output4]++ fixRedundancyWarning 1 (IndividualThings ["foo", "baz"]) input5+ @?= Just output5++ fixRedundancyWarning 2 (IndividualThings ["bar"]) input6+ @?= Just output6++ fixRedundancyWarning 3 (IndividualThings ["bar"]) input7+ @?= Just output7++ fixRedundancyWarning 1 (IndividualThings ["Bar"]) [input8]+ @?= Just [output8]++ fixRedundancyWarning 1 (IndividualThings ["two"]) [input9]+ @?= Just [output9]++ fixRedundancyWarning 1 (IndividualThings ["+~"]) [input10]+ @?= Just [output10]++ fixRedundancyWarning 1 (IndividualThings [":~:"]) [input11]+ @?= Just [output11]+ ]++input1, output1 :: BS.ByteString+input1 = "import Foo.Bar (foo, bar)"+output1 = "import Foo.Bar (bar)"++input2, output2 :: BS.ByteString+input2 = "import Foo.Bar (foo, bar)"+output2 = "import Foo.Bar (foo)"++input3, output3 :: BS.ByteString+input3 = "import Foo.Bar (foo, bar, baz)"+output3 = "import Foo.Bar (bar)"++input4, output4 :: BS.ByteString+input4 = "import Foo.Bar (foo, bar, baz)"+output4 = "import Foo.Bar (foo, baz)"++input5, output5 :: [BS.ByteString]+input5 = [ "import Foo.Bar ( foo"+ , " , bar"+ , " , baz"+ , " )"+ ]+output5 = [ "import Foo.Bar ( bar"+ , " )"+ ]++input6, output6 :: [BS.ByteString]+input6 = [ "import Foo.Bar ( foo"+ , " , bar"+ , " , baz"+ , " )"+ ]+output6 = [ "import Foo.Bar ( foo"+ , " , baz"+ , " )"+ ]++input7, output7 :: [BS.ByteString]+input7 = [ "import Foo.Bar"+ , " ( foo"+ , " , bar"+ , " , baz"+ , " )"+ ]+output7 = [ "import Foo.Bar"+ , " ( foo"+ , " , baz"+ , " )"+ ]++input8, output8 :: BS.ByteString+input8 = "import Foo (foo, Bar(one, two), baz)"+output8 = "import Foo (foo, baz)"++input9, output9 :: BS.ByteString+input9 = "import Foo (foo, Bar(one, two), baz)"+output9 = "import Foo (foo, Bar(one), baz)"++input10, output10 :: BS.ByteString+input10 = "import Foo (foo, (+~), baz)"+output10 = "import Foo (foo, baz)"++input11, output11 :: BS.ByteString+input11 = "import Foo (foo, (:~:)(..), baz)"+output11 = "import Foo (foo, baz)"++input12, output12 :: BS.ByteString+input12 = "import Foo (foo, (:~:)(one, two), baz)"+output12 = "import Foo (foo, (:~:)(one), baz)"