Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

ugly hack to avoid upper case letters, testing

  • Loading branch information...
commit ffcd9c398a8145faf1a16df91d0ea4891a5cd4b2 1 parent c095963
@JPMoresmau JPMoresmau authored
View
8 src/Scion/Browser/Build.hs
@@ -25,6 +25,7 @@ import Text.Parsec.Error (ParseError)
import Text.ParserCombinators.Parsec.Error (newErrorMessage, Message(..))
import Text.ParserCombinators.Parsec.Pos (newPos)
+
baseDbUrl :: String
baseDbUrl = "http://haskell.org/hoogle/base.txt"
@@ -98,8 +99,8 @@ updateDatabase oldDb pkgInfo = do let dbList = nub $ map fst $ M.toList o
filteredDb = foldr (\pid db -> M.delete pid db) oldDb toRemove
let ghcVersion = getGhcInstalledVersion installedList
logToStdout $ "Adding " ++ show (map (\(PackageIdentifier (PackageName name) _) -> name) toAdd)
- (addedDb, errors) <- createCabalDatabase' ghcVersion toAdd False
- logToStdout $ show errors
+ (addedDb, _) <- createCabalDatabase' ghcVersion toAdd True
+ --logToStdout $ show errors
return $ M.union filteredDb addedDb
removeSmallVersions :: [PackageIdentifier] -> [PackageIdentifier]
@@ -134,7 +135,8 @@ getCabalHoogle ghcVersion pid ifFailCreateEmpty tmp =
Left e -> return $ if ifFailCreateEmpty
then Right (Package NoDoc pid M.empty)
else Left e
- Right (Package doc _ info) -> return $ Right (Package doc pid info)
+ Right (Package doc _ info) -> do
+ return $ Right (Package doc pid info)
-- | Get the database from a Cabal package.
getCabalHoogle' :: Version -> PackageIdentifier -> FilePath -> IO (Either ParseError (Documented Package))
View
2  src/Scion/Browser/FileUtil.hs
@@ -42,7 +42,7 @@ downloadHoogleFile url = do
then return $ Just (SBS8.pack response)
else return Nothing
--- |Downloads a file from the internetn, using the system proxy
+-- |Downloads a file from the internet, using the system proxy
fetchURL :: String -> IO (String)
fetchURL url=do
pr<-fetchProxy False
View
2  src/Scion/Browser/Parser/Internal.hs
@@ -445,7 +445,7 @@ varid = try (do initial <- lower <|> char '_'
char ')'
return var)
<|>
- try (do var <- many1 (noneOf [',',')','(',' ','\r','\n','\t'])
+ try (do var <- many1 (noneOf [',',')','(',' ','\r','\n','\t','A','B','C','D','E','F','G','H','I','J','K','L','M','N','O','P','Q','R','S','T','U','V','W','X','Y','Z'])
guard $ not (var `elem` haskellReservedOps)
return $ Symbol NoDoc var)
View
25 test/Scion/Browser/ParserTests.hs
@@ -13,12 +13,14 @@ import Data.Serialize
import Data.List
import qualified Data.Aeson as A
import qualified Data.ByteString.Lazy.UTF8 as LBS
-
-
+import qualified Data.ByteString.Lazy.Char8 as LBS
+import qualified Language.Haskell.Exts.Parser as Parser
+import Language.Haskell.Exts.Extension
import Data.List.Split
+--import Scion.Browser.FileUtil
parserTests :: [Test]
-parserTests = checkValids
+parserTests = checkTypeParse:checkValids
checkValids :: [Test]
checkValids=map (\(f,exps)->TestLabel ("Testing parsing "++f) (TestCase (checkValid f exps))) [
@@ -31,7 +33,7 @@ checkValids=map (\(f,exps)->TestLabel ("Testing parsing "++f) (TestCase (checkVa
,("haskell98",[("Maybe",["Maybe","isJust"])])
,("haskell2010",[("Data.Array",["Array","ixmap"]),("Data.Complex",["(:+)"])])
,("ghc-prim",[])
- ,("base-unicode-symbols",[("Data.Ord.Unicode",["(≯)"])])
+ ,("base-unicode-symbols",[("Data.Ord.Unicode",["(≯)"]),("Control.Arrow.Unicode",["(⋙)"])])
]
checkValid :: String -> [(String,[String])] -> IO()
@@ -39,6 +41,9 @@ checkValid name exps=do
let f="data" </> addExtension name "txt"
fe<-doesFileExist f
assertBool (f++" does not exist") fe
+ --Just txt<-downloadHoogleFile "http://hackage.haskell.org/packages/archive/warp/0.4.4/doc/html/warp.txt"
+ --
+ --let res=parseHoogleString "<package>" txt
res<-parseHoogleFile f
case res of
Right p@(Package _ pid m)->do
@@ -64,6 +69,16 @@ checkPresence m (modName,exps)=do
mapM_ (\e->assertBool e (elem e names)) exps
let res=A.toJSON decls
let output=LBS.toString (A.encode res)
+ assertBool modName (not $ isInfixOf "not parsed" output)
mapM_ (\e->mapM_ (\e2->assertBool e2 (isInfixOf e2 output))(splitOn "," e)) exps
return ()
-
+
+checkTypeParse :: Test
+checkTypeParse= TestLabel "Testing checkTypeParse" (TestCase (do
+ let parseString="Category (⇝) => (α ⇝ β) -> (β ⇝ γ) -> (α ⇝ γ)" -- does not work if I remove the brackets around the first squiggly arrow
+ let parseTypeMode=Parser.ParseMode "" knownExtensions False False Nothing
+ let parsed = Parser.parseTypeWithMode parseTypeMode parseString
+ case parsed of
+ Parser.ParseFailed _ msg -> assertFailure msg
+ Parser.ParseOk _ -> return ()
+ ))

0 comments on commit ffcd9c3

Please sign in to comment.
Something went wrong with that request. Please try again.