hasktags 0.68.6 → 0.68.7

raw patch · 5 files changed

+89/−115 lines, 5 filesdep +utf8-stringdep −HUnitdep ~basedep ~bytestringdep ~directory

Dependencies added: utf8-string

Dependencies removed: HUnit

Dependency ranges changed: base, bytestring, directory, json

Files

• hasktags.cabal +37/−11
• src/Hasktags.hs +14/−3
• src/Main.hs +1/−0
• testcases/monad-base-control.hs +37/−0
• tests/Test.hs +0/−101

@@ -1,5 +1,5 @@ Name: hasktags-Version: 0.68.6+Version: 0.68.7 Copyright: The University Court of the University of Glasgow License: BSD3 License-File: LICENSE@@ -41,6 +41,7 @@   testcases/testcase10.hs   testcases/testcase11.hs   testcases/simple.hs+  testcases/monad-base-control.hs  Flag debug   Default: False@@ -53,6 +54,7 @@ Executable hasktags     Main-Is: Main.hs     Build-Depends:+      utf8-string,       base >= 4 && < 5,       bytestring >= 0.9 && < 0.11,       directory >= 1.1 && < 1.3,@@ -69,14 +71,38 @@   if flag(debug)     cpp-options: -Ddebug -Test-Suite test-  Type: exitcode-stdio-1.0-  Main-Is: Test.hs-  hs-source-dirs: src, tests-  Build-Depends: base, bytestring, directory, filepath, json,-    HUnit >= 1.2 && < 1.3-  ghc-options: -Wall-  default-language: Haskell2010+-- Either ./Setup sdist complains about missing executable for test case or+-- ./Setup configure (having same executable twice, "consider this a bug") -  if flag(debug)-    cpp-options: -Ddebug+-- Executable test+--     Main-Is: Test.hs+--     Build-Depends:+--       utf8-string,+--       base >= 4 && < 5,+--       bytestring >= 0.9 && < 0.11,+--       directory >= 1.1 && < 1.3,+--       filepath,+--       json >= 0.5 && < 0.8,+--       HUnit >= 1.2 && < 1.3+--     other-modules: Tags, Hasktags, DebugShow+--     hs-source-dirs: src, tests+--     ghc-options: -Wall+--     default-language: Haskell2010+-- +--   if !os(windows)+--     build-depends: unix+-- +--   if flag(debug)+--     cpp-options: -Ddebug+-- +-- Test-Suite test+--   Type: exitcode-stdio-1.0+--   Main-Is: Test.hs+--   hs-source-dirs: src, tests+--   Build-Depends: base, bytestring, directory, filepath, json,+--     HUnit >= 1.2 && < 1.3+--   ghc-options: -Wall+--   default-language: Haskell2010+-- +--   if flag(debug)+--     cpp-options: -Ddebug

@@ -16,6 +16,9 @@  -- the lib import qualified Data.ByteString.Char8 as BS++import qualified Data.ByteString.UTF8 as BS8 -- see notes at utf8_to_char8_hack+ import Data.Char import Data.List import Data.Maybe@@ -149,6 +152,14 @@           when cache (writeFile cacheFilename (encodeJSON filedata))           return filedata +-- eg Data.Text says that using ByteStrings could be fastest depending on ghc+-- platform and whatnot - so let's keep the hacky BS.readFile >>= BS.unpack+-- usage till there is a problem, still need to match utf-8 chars like this: ⇒+-- to get correct class names, eg MonadBaseControl case (testcase testcases/monad-base-control.hs)+-- so use the same conversion which is applied to files when they got read ..+utf8_to_char8_hack :: String -> String+utf8_to_char8_hack = BS.unpack . BS8.fromString+ -- Find the definitions in a file findThings :: Bool -> FileName -> IO FileData findThings ignoreCloseImpl filename =@@ -327,7 +338,7 @@             = case (head                   . dropWhile isParenOpen                   . reverse-                  . takeWhile ((/= "=>") . tokenString)+                  . takeWhile ((not . (`elem` ["=>", utf8_to_char8_hack "⇒"])) . tokenString)                   . reverse) lst of               (Token name p) -> Just $ FoundThing FTClass name p               _ -> Nothing@@ -411,9 +422,9 @@  -- this only exists for test case testcases/HUnitBase.lhs (bird literate haskell style) getTopLevelIndent :: Bool -> [[Token]] -> Int-getTopLevelIndent isLiterate [] = 0 -- (no import found , assuming indent 0 : this can be+getTopLevelIndent _ [] = 0 -- (no import found , assuming indent 0 : this can be                          -- done better but should suffice for most needs-getTopLevelIndent isLiterate ((nl:next:rest):xs) = if "import" == (tokenString next)+getTopLevelIndent isLiterate ((nl:next:_):xs) = if "import" == (tokenString next)                           then let (NewLine i) = nl in i                           else getTopLevelIndent isLiterate xs getTopLevelIndent isLiterate (_:xs) = getTopLevelIndent isLiterate xs

@@ -18,6 +18,7 @@ import System.Exit import Control.Monad +hsSuffixesDefault :: Mode hsSuffixesDefault =  HsSuffixes [ ".hs", ".lhs" ]  options :: [OptDescr Mode]

@@ -0,0 +1,37 @@+-- to be found MonadBaseControl+-- this tests the utf-8 characters++class MonadBase b m ⇒ MonadBaseControl b m | m → b where+    -- | Monadic state of @m@.+    data StM m ∷ * → *++    -- | @liftBaseWith@ is similar to 'liftIO' and 'liftBase' in that it+    -- lifts a base computation to the constructed monad.+    --+    -- Instances should satisfy similar laws as the 'MonadIO' and 'MonadBase' laws:+    --+    -- @liftBaseWith . const . return = return@+    --+    -- @liftBaseWith (const (m >>= f)) = liftBaseWith (const m) >>= liftBaseWith . const . f@+    --+    -- The difference with 'liftBase' is that before lifting the base computation+    -- @liftBaseWith@ captures the state of @m@. It then provides the base+    -- computation with a 'RunInBase' function that allows running @m@+    -- computations in the base monad on the captured state.+    liftBaseWith ∷ (RunInBase m b → b a) → m a++    -- | Construct a @m@ computation from the monadic state of @m@ that is+    -- returned from a 'RunInBase' function.+    --+    -- Instances should satisfy:+    --+    -- @liftBaseWith (\\runInBase -> runInBase m) >>= restoreM = m@+    restoreM ∷ StM m a → m a++-- | A function that runs a @m@ computation on the monadic state that was+-- captured by 'liftBaseWith'+--+-- A @RunInBase m@ function yields a computation in the base monad of @m@ that+-- returns the monadic state of @m@. This state can later be used to restore the+-- @m@ computation using 'restoreM'.+type RunInBase m b = ∀ a. m a → b (StM m a)

@@ -1,101 +0,0 @@-module Main where--import Hasktags-import Tags--import Control.Monad-import Data.List-import System.Directory-import System.Exit--import qualified Data.ByteString.Char8 as BS--import Test.HUnit--{- TODO-Test the library (recursive, caching, ..)-But that's less likely to break--}---- all comments should differ at the beginning-comments :: [BS.ByteString] -> String -> [String]-comments lns comment = filter (not . null) $ map hitOrEmpty lns-  where-    c = BS.pack $ comment ++ " "-    hitOrEmpty :: BS.ByteString -> String-    hitOrEmpty bs =-      let ds = BS.dropWhile (== ' ') bs-      in if c `BS.isPrefixOf` ds-            then BS.unpack $ BS.drop (BS.length c) ds-            else ""--tagComments :: [BS.ByteString] -> String -> [String]-tagComments lns comment-  = map (takeWhile (not . (`elem` "\n\r "))) $ comments lns comment--testToBeFound :: [String] -> [String] -> Test-testToBeFound foundTagNames toBeFound =-        "these were not found"-        ~: [] ~?= filter (not . (`elem` foundTagNames)) toBeFound--testNotToBeFound :: [String] -> [String] -> Test-testNotToBeFound foundTagNames notToBeFound =-        "these should not have been found"-        ~: [] ~=? filter (`elem` foundTagNames) notToBeFound--testToBeFoundOnce :: [String] -> [String] -> Test-testToBeFoundOnce foundTagNames list =-        "these should have been found exactly one time"-        ~: []-          ~=? [name-            | name <- list, 1 /= length (filter (==  name ) foundTagNames)]--etagsToBeFound :: String -> [String] -> Test-etagsToBeFound etags toBeFound =-        "these were not found on TAGS"-        ~: [] ~=? filter (not . (`isInfixOf` etags)) toBeFound--etagsNotToBeFound :: String -> [String] -> Test-etagsNotToBeFound etags notToBeFound =-        "these should not have been found on TAGS"-        ~: [] ~=? filter (`isInfixOf` etags) notToBeFound--etagsToBeFoundOnce :: String -> [String] -> Test-etagsToBeFoundOnce etags list =-        "these should not have been found on TAGS"-        ~: [] ~=? [ name | name <- list, 1 /= length (infixes name etags)]--infixes :: Eq a => [a] -> [a] -> [[a]]-infixes needle haystack = filter (isPrefixOf needle) (tails haystack)--createTestCase :: FilePath -> IO Test-createTestCase filename = do-  bs <- BS.readFile filename-  let lns = BS.lines bs-  let fd = findThingsInBS True filename bs-  let FileData _ things = fd--  let foundTagNames = [name | FoundThing _ name _ <- things]-  let etags = etagsDumpFileData fd--  let testList = TestList [-          testToBeFound foundTagNames (tagComments lns "-- to be found"),-          testNotToBeFound foundTagNames (tagComments lns "-- not to be found"),-          testToBeFoundOnce-            foundTagNames-            (tagComments lns "-- once to be found"),-          etagsToBeFound etags (comments lns "-- TAGS to be found"),-          etagsNotToBeFound etags (comments lns "-- TAGS not to be found"),-          etagsToBeFoundOnce etags (comments lns "-- TAGS once to be found")-        ]--  return $ filename ~: testList--main :: IO ()-main-  = do-    setCurrentDirectory "testcases"-    files <- getDirectoryContents "."-    tests <- mapM createTestCase $ filter (not . (`elem` [".", "..", "expected_failures_testing_suite.hs"])) files-    counts_ <- runTestTT $ TestList tests-    when (errors counts_ + failures counts_ > 0) exitFailure