argon 0.3.1.2 → 0.3.2.0

raw patch · 14 files changed

+186/−25 lines, 14 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +13/−0
• USAGE.txt +1/−2
• argon.cabal +4/−3
• src/Argon/Parser.hs +5/−3
• src/Argon/Preprocess.hs +11/−5
• src/Argon/SYB/Utils.hs +40/−0
• src/Argon/Visitor.hs +1/−1
• test/ArgonSpec.hs +31/−11
• test/data/cpp-psyn.hs +11/−0
• test/data/datakinds.hs +20/−0
• test/data/foreignimports.hs +10/−0
• test/data/scopedtypevariables.hs +11/−0
• test/data/th.hs +7/−0
• test/data/typefamilies.hs +21/−0

@@ -2,6 +2,19 @@  This package uses [Semantic Versioning][1]. +## v0.3.2.0++- Fix error in CPP processing: #14+- Include updated `everythingStaged` code (by @alanz): #20++## v0.3.1.2++- Add `stack-7.8.yaml` to sdist. It's then possible to run tests from sdist.++## v0.3.1.1++- Add test data to sdist: fpco/stackage#932+ ## v0.3.1.0  - Add compatibility with GHC 7.8: #6

@@ -1,6 +1,5 @@ Usage:-    argon [-h] [--no-color] [--json] [-m=<min>] <paths>...-    argon [-h] [--no-color] [--m=<min>] [--json] <paths>...+    argon [options] <paths>...  Options:     -h --help       show this help

@@ -1,5 +1,5 @@ name:                argon-version:             0.3.1.2+version:             0.3.2.0 synopsis:            Measure your code's complexity homepage:            http://github.com/rubik/argon bug-reports:         http://github.com/rubik/argon/issues@@ -25,7 +25,7 @@     CHANGELOG.md     USAGE.txt     test/data/*.hs-tested-with: GHC >= 7.8+tested-with: GHC >= 7.8 && < 8  library   hs-source-dirs:      src@@ -37,6 +37,7 @@                        Argon.Types                        Argon.Preprocess                        Argon.Loc+                       Argon.SYB.Utils   build-depends:       base             >=4.7    && <5                      , ansi-terminal    >=0.6                      , aeson            >=0.8@@ -82,7 +83,6 @@                      , hspec            >=2.1                      , QuickCheck       -any                      , filepath         >=1.3-                     , argon            -any   ghc-options:         -Wall -threaded -rtsopts -with-rtsopts=-N   if impl(ghc < 7.8)     buildable: False@@ -96,6 +96,7 @@                        Argon.Types                        Argon.Preprocess                        Argon.Loc+                       Argon.SYB.Utils  test-suite style   type:                exitcode-stdio-1.0

@@ -55,12 +55,14 @@     GHC.runGhc (Just libdir) $ do       dflags <- initDynFlags file       let useCpp = GHC.xopt GHC.Opt_Cpp dflags-      fileContents <-+      (fileContents, dflags1) <-         if useCpp            then getPreprocessedSrcDirect cppOptions file-           else GHC.liftIO $ readFile file+           else do+               contents <- GHC.liftIO $ readFile file+               return (contents, dflags)       return $-        case parseCode dflags file fileContents of+        case parseCode dflags1 file fileContents of           GHC.PFailed ss m -> Left $ tagMsg (srcSpanToLoc ss)                                             (GHC.showSDoc dflags m)           GHC.POk _ pmod   -> Right pmod

@@ -1,5 +1,6 @@--- The following code is taken from ghc-exactprint, because adding a dependency--- for just one module seemed excessive.+-- The following code is taken and modified from ghc-exactprint, because adding+-- a dependency for just one module and then adding wrappers for that module+-- seemed excessive. {-# LANGUAGE CPP #-} {-# LANGUAGE RecordWildCards #-} -- | This module provides support for CPP and interpreter directives.@@ -17,6 +18,7 @@ import qualified DynFlags       as GHC import qualified MonadUtils     as GHC import qualified StringBuffer   as GHC+import qualified DriverPhases   as GHC import qualified DriverPipeline as GHC  data CppOptions = CppOptions@@ -29,9 +31,12 @@ defaultCppOptions :: CppOptions defaultCppOptions = CppOptions [] [] [] -getPreprocessedSrcDirect :: (GHC.GhcMonad m) => CppOptions -> FilePath -> m String+getPreprocessedSrcDirect :: (GHC.GhcMonad m)+                         => CppOptions+                         -> FilePath+                         -> m (String, GHC.DynFlags) getPreprocessedSrcDirect cppOptions src =-    (\(a,_,_) -> a) <$> getPreprocessedSrcDirectPrim cppOptions src+    (\(s, _, d) -> (s, d)) <$> getPreprocessedSrcDirectPrim cppOptions src  getPreprocessedSrcDirectPrim :: (GHC.GhcMonad m)                               => CppOptions@@ -41,7 +46,8 @@   hscEnv <- GHC.getSession   let dfs = GHC.extractDynFlags hscEnv       newEnv = GHC.replaceDynFlags hscEnv (injectCppOptions cppOptions dfs)-  (dflags', hspp_fn) <- GHC.liftIO $ GHC.preprocess newEnv (file, Nothing)+  (dflags', hspp_fn) <-+      GHC.liftIO $ GHC.preprocess newEnv (file, Just (GHC.Cpp GHC.HsSrcFile))   buf <- GHC.liftIO $ GHC.hGetStringBuffer hspp_fn   txt <- GHC.liftIO $ readFile hspp_fn   return (txt, buf, dflags')

@@ -0,0 +1,40 @@+-- The following code is temporarily taken from @alanz's fork of+-- nominolo/ghc-syb. Argon will use the original ghc-syb when a new version+-- is released on Hackage with @alanz's fixes.+{-# LANGUAGE CPP #-}+{-# LANGUAGE RankNTypes #-}+module Argon.SYB.Utils (Stage(..), everythingStaged)+    where++import GHC+import NameSet (NameSet)+import Data.Generics+#if __GLASGOW_HASKELL__ <= 708+import Coercion+#endif+++-- | Ghc Ast types tend to have undefined holes, to be filled+--   by later compiler phases. We tag Asts with their source,+--   so that we can avoid such holes based on who generated the Asts.+data Stage = Parser | Renamer | TypeChecker deriving (Eq, Ord, Show)++-- | Like 'everything', but avoid known potholes, based on the 'Stage' that+--   generated the Ast.+everythingStaged :: Stage -> (r -> r -> r) -> r -> GenericQ r -> GenericQ r+everythingStaged stage k z f x+  | (const False+#if __GLASGOW_HASKELL__ <= 708+      `extQ` postTcType+      `extQ` nameList+      `extQ` coercion+#endif+      `extQ` fixity `extQ` nameSet) x = z+  | otherwise = foldl k (f x) (gmapQ (everythingStaged stage k z f) x)+  where nameSet    = const (stage `elem` [Parser,TypeChecker]) :: NameSet -> Bool+#if __GLASGOW_HASKELL__ <= 708+        postTcType = const (stage < TypeChecker)               :: PostTcType -> Bool+        nameList   = const (stage < TypeChecker)               :: [Name] -> Bool+        coercion   = const (stage < TypeChecker)               :: Coercion -> Bool+#endif+        fixity     = const (stage < Renamer)                   :: GHC.Fixity -> Bool

@@ -2,7 +2,7 @@     where  import Data.Generics (Data, Typeable, mkQ)-import GHC.SYB.Utils (Stage(..), everythingStaged)+import Argon.SYB.Utils (Stage(..), everythingStaged) import Control.Arrow ((&&&))  import qualified GHC

@@ -1,6 +1,5 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} {-# LANGUAGE CPP #-}-{-# LANGUAGE StandaloneDeriving #-}  module ArgonSpec (spec)     where@@ -114,13 +113,34 @@                       , CC ((94, 17), "idents", 1)                       , CC ((103, 21), "m", 1)                       ]-        it "applies CPP when needed" $-            "cpp.hs" `shouldAnalyze` Right [CC (lo 5, "f", 4)]-        it "catches syntax errors" $-            "syntaxerror.hs" `shouldAnalyze`-                Left "2:1 parse error (possibly incorrect indentation or mismatched brackets)"-        it "catches CPP parsing errors" $-            unsafePerformIO (analyze (path "cpp-error.hs")) `shouldSatisfy`-            \(_, res) ->-                isLeft res && ("2:0  error: unterminated #else"-                               `isPrefixOf` head (lefts [res]))+        describe "extensions" $ do+-- Not even GHC 7.8.4 is able to run the file below, so it's not an Argon bug+#if __GLASGOW_HASKELL__ >= 710+            it "correctly applies CPP" $+                "cpp-psyn.hs" `shouldAnalyze` Right []+#endif+            it "applies CPP when needed" $+                "cpp.hs" `shouldAnalyze` Right [CC (lo 5, "f", 4)]+            it "works with TemplateHaskell" $+                "th.hs" `shouldAnalyze` Right [CC (lo 7, "foo", 1)]+            it "works with DataKinds, GADTs, KindSignatures" $+                "datakinds.hs" `shouldAnalyze`+                    Right [ CC (lo 16, "taskOneWorker", 1)+                          , CC (lo 20, "main", 1)]+            it "works with ScopedTypeVariables" $+                "scopedtypevariables.hs" `shouldAnalyze`+                    Right [CC (lo 9, "catchNonAsync", 1)]+            it "works with TypeFamilies" $+                "typefamilies.hs" `shouldAnalyze` Right []+            it "works with ForeignImport" $+                "foreignimports.hs" `shouldAnalyze` Right []+        describe "errors" $ do+            it "catches syntax errors" $+                "syntaxerror.hs" `shouldAnalyze`+                    Left ("2:1 parse error (possibly incorrect indentation" +++                          " or mismatched brackets)")+            it "catches CPP parsing errors" $+                unsafePerformIO (analyze (path "cpp-error.hs")) `shouldSatisfy`+                \(_, res) ->+                    isLeft res && ("2:0  error: unterminated #else"+                                   `isPrefixOf` head (lefts [res]))

@@ -0,0 +1,11 @@+{-# LANGUAGE CPP #-}+#ifndef HLINT+{-# LANGUAGE ViewPatterns #-}+#endif+{-# LANGUAGE PatternSynonyms #-}++data Counted a = Counted Int [a] deriving (Eq, Ord, Read, Show)++pattern (:+) :: () => () => a -> Counted a -> Counted a+pattern a :+ as <- Counted (subtract 1 -> i) (a : (Counted i -> as)) where+  a :+ Counted i as = Counted (i+1) (a:as)

@@ -0,0 +1,20 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE GADTs #-}++data JobDescription = JobOne+                    | JobTwo+                    | JobThree+  deriving (Show, Eq)++data SJobDescription :: JobDescription -> * where+    SJobOne :: { jobOneN :: Int } -> SJobDescription JobOne+    SJobTwo :: SJobDescription JobTwo+    SJobThree :: { jobThreeN :: Int } -> SJobDescription JobThree++taskOneWorker :: SJobDescription JobOne -> IO ()+taskOneWorker t = do+    putStrLn $ "Job: " ++ (show $ jobOneN t)++main :: IO ()+main = taskOneWorker (SJobOne 10)

@@ -0,0 +1,10 @@+module Internal.Sparse where++import Foreign.C.Types(CInt(..))+import Foreign(Ptr)++foreign import ccall unsafe "smXv"+  c_smXv :: SMxV++foreign import ccall unsafe "smTXv"+  c_smTXv :: SMxV

@@ -0,0 +1,11 @@+{-# LANGUAGE ScopedTypeVariables #-}++module Utility.Exception where++import Control.Monad.Catch as X hiding (Handler)+import qualified Control.Monad.Catch as M++catchNonAsync :: MonadCatch m => m a -> (SomeException -> m a) -> m a+catchNonAsync a onerr = a catches+ [ M.Handler ( (e :: SomeException) -> onerr e)+ ]

@@ -0,0 +1,7 @@+{-# LANGUAGE TemplateHaskell #-}+module Blow where++import Language.Haskell.TH++foo :: Q Exp+foo = [| \f -> f 2 |]

@@ -0,0 +1,21 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}++import Control.Lens.Lens+import Data.Functor.Identity+import Data.Functor.Product+import Data.Proxy (Proxy (Proxy))+import GHC.Generics (Generic (..), (:*:) (..), K1 (..), M1 (..), U1 (..))+import Control.Applicative++type family GSize (f :: * -> *)+type instance GSize U1 = Z+type instance GSize (K1 i c) = S Z+type instance GSize (M1 i c f) = GSize f+type instance GSize (a :*: b) = Add (GSize a) (GSize b)