packages feed

ariadne (empty) → 0.1

raw patch · 9 files changed

+461/−0 lines, 9 filesdep +Cabaldep +basedep +bertsetup-changed

Dependencies added: Cabal, base, bert, containers, haskell-names, haskell-packages, haskell-src-exts, mtl, utf8-string

Files

+ Ariadne.hs view
@@ -0,0 +1,87 @@+{-# LANGUAGE ViewPatterns, OverloadedStrings #-}+module Main where++import Ariadne.GlobalNameIndex+import Ariadne.Index+import qualified Ariadne.SrcMap as SrcMap++import Language.Haskell.Names+import Language.Haskell.Names.Interfaces+import Language.Haskell.Names.SyntaxUtils+import Language.Haskell.Names.Imports+import Language.Haskell.Exts.Annotated+import Distribution.HaskellSuite.Packages++import Control.Applicative+import Control.Monad.Trans+import Control.Monad+import Control.Exception+import Text.Printf++import Data.BERT+import Network.BERT.Server+import Network.BERT.Transport+import qualified Data.ByteString.Lazy.UTF8 as UTF8++-- these should probably come from the Cabal file+defaultLang = Haskell2010+defaultExts = []++work :: String -> Int -> Int -> IO (Maybe Origin)+work mod line col = handleExceptions $ do+  parseResult <-+    parseFileWithMode+      defaultParseMode { parseFilename = mod }+      mod++  case parseResult of+    ParseFailed loc msg ->+      return $ Just $ ResolveError $ printf "%s: %s" (prettyPrint loc) msg++    ParseOk parsed -> do++      let pkgs = []+      (resolved, impTbl) <-+        flip evalNamesModuleT pkgs $ do+          -- computeInterfaces lang exts mod+          let extSet = moduleExtensions defaultLang defaultExts parsed+          (,) <$>+            (annotateModule defaultLang defaultExts parsed) <*>+            (fmap snd $ processImports extSet $ getImports parsed)++      let+        gIndex = mkGlobalNameIndex impTbl (getPointLoc <$> parsed)+        srcMap = mkSrcMap gIndex (fmap srcInfoSpan <$> resolved)++      return $ SrcMap.lookup noLoc { srcLine = line, srcColumn = col } srcMap+  where+    handleExceptions a =+      try (a >>= evaluate) >>= either (\e -> return $ Just $ ResolveError $ show (e::SomeException)) return++main = do+  t <- fromHostPort "" 39014+  serve t dispatch+  where+    -- dispatch _ _ args = do print args; return $ Success $ NilTerm+    dispatch "ariadne" "find" [BinaryTerm file, IntTerm line, IntTerm col] =+      work (UTF8.toString file) line col >>= \result -> return . Success $+        case result of+          Nothing -> TupleTerm [AtomTerm "no_name"]+          Just (LocKnown (SrcLoc file' line' col')) ->+            TupleTerm+              [ AtomTerm "loc_known"+              , BinaryTerm (UTF8.fromString file')+              , IntTerm line'+              , IntTerm col'+              ]+          Just (LocUnknown modName) ->+            TupleTerm+              [ AtomTerm "loc_unknown"+              , BinaryTerm (UTF8.fromString modName)+              ]+          Just (ResolveError er) ->+            TupleTerm+              [ AtomTerm "error"+              , BinaryTerm (UTF8.fromString er)+              ]+    dispatch _ _ _ = return NoSuchFunction
+ Ariadne/GlobalNameIndex.hs view
@@ -0,0 +1,77 @@+{-# LANGUAGE TupleSections, TypeFamilies #-}+module Ariadne.GlobalNameIndex (mkGlobalNameIndex) where++import Language.Haskell.Names+import qualified Language.Haskell.Names.GlobalSymbolTable as Global+import Language.Haskell.Names.SyntaxUtils+import Language.Haskell.Names.GetBound+import Language.Haskell.Exts.Annotated+import Distribution.HaskellSuite.Modules+import qualified Data.Map as Map+import Data.Maybe++import Ariadne.Types++mkGlobalNameIndex+  :: Global.Table -> Module SrcLoc -> GlobalNameIndex+mkGlobalNameIndex tbl mod =+  let+    Module _ _ _ _ ds = mod+    ModuleName _ modname = getModuleName mod++    names = concatMap (indexDecl tbl) ds++  in+    Map.fromList+      [ ((OrigName Nothing (GName modname (nameToString n)), level), ann n)+      | (n, level) <- names+      ]++indexDecl :: Global.Table -> Decl SrcLoc -> [(Name SrcLoc, NameLevel)]+indexDecl tbl d =+  case d of+    TypeDecl _ dh _ -> [(hname dh, TypeLevel)]+    TypeFamDecl _ dh _ -> [(hname dh, TypeLevel)]++    DataDecl _ _ _ dh qualConDecls _ ->+      ((hname dh, TypeLevel) :) . map (, ValueLevel) $ do -- list monad++      QualConDecl _ _ _ conDecl <- qualConDecls+      case conDecl of+        ConDecl _ n _ -> return n+        InfixConDecl _ _ n _ -> return n+        RecDecl _ n fields ->+          n :+          [f | FieldDecl _ fNames _ <- fields, f <- fNames]++    GDataDecl _ dataOrNew _ dh _ gadtDecls _ ->+      -- As of 1.14.0, HSE doesn't support GADT records.+      -- When it does, this code should be rewritten similarly to the+      -- DataDecl case.+      -- (Also keep in mind that GHC doesn't create selectors for fields+      -- with existential type variables.)+          (hname dh, TypeLevel) :+        [ (cn, ValueLevel)+        | GadtDecl _ cn _ <- gadtDecls+        ]++    ClassDecl _ _ dh _ mds ->+      (hname dh, TypeLevel) :+      let+        ms = getBound tbl d+        cdecls = fromMaybe [] mds+      in+          (hname dh, TypeLevel) :+        [ (hname dh, TypeLevel) | ClsTyFam   _   dh _ <- cdecls ] +++        [ (hname dh, TypeLevel) | ClsDataFam _ _ dh _ <- cdecls ] +++        [ (mn, ValueLevel) | mn <- ms ]++    FunBind _ ms -> map (, ValueLevel) $ getBound tbl ms++    PatBind _ p _ _ _ -> map (, ValueLevel) $ getBound tbl p++    ForImp _ _ _ _ fn _ -> [(fn, ValueLevel)]++    _ -> []+  where+    hname = fst . splitDeclHead
+ Ariadne/Index.hs view
@@ -0,0 +1,43 @@+{-# LANGUAGE ScopedTypeVariables, ViewPatterns #-}++module Ariadne.Index where++import Language.Haskell.Names+import qualified Language.Haskell.Names.GlobalSymbolTable as Global+import Language.Haskell.Exts.Annotated+import Data.Foldable+import Data.Maybe+import qualified Data.Map as Map++import Ariadne.Types+import qualified Ariadne.SrcMap as SrcMap++data Origin+  = LocKnown SrcLoc+  | LocUnknown ModuleNameS+  | ResolveError String+  deriving Show++mkSrcMap+  :: Foldable a+  => GlobalNameIndex+  -> a (Scoped SrcSpan)+  -> SrcMap.SrcMap Origin+mkSrcMap gIndex =+  foldMap $ \(Scoped nameInfo span) ->+    case nameInfo of+      LocalValue bindingLoc ->+        SrcMap.singleton span (LocKnown bindingLoc)+      GlobalValue (sv_origName -> orig) ->+        SrcMap.singleton span $ findGlobal ValueLevel orig+      GlobalType  (st_origName -> orig) ->+        SrcMap.singleton span $ findGlobal TypeLevel  orig+      ScopeError er ->+        SrcMap.singleton span $ ResolveError $ ppError er+      _ -> SrcMap.empty+  where+    findGlobal level orig =+      maybe+        (LocUnknown $ gModule . origGName $ orig)+        LocKnown+        (Map.lookup (orig, level) gIndex)
+ Ariadne/SrcMap.hs view
@@ -0,0 +1,66 @@+-- | A map indexed by 'SrcSpan' and addressable by 'SrcLoc'.+--+-- Notes:+--+-- * the 'srcFilename' component is ignored+--+-- * when some of the inserted intervals are overlapping, the behaviour is+-- undefined+{-# LANGUAGE ViewPatterns #-}+module Ariadne.SrcMap+  ( SrcMap+  , insert+  , lookup+  , union+  , empty+  , singleton+  ) where++import Prelude hiding (lookup)+import Language.Haskell.Exts.SrcLoc hiding (Loc(..))+import qualified Data.Map as Map+import Data.Monoid++-- | @Loc line column@+data Loc = Loc !Int !Int+  deriving (Eq, Ord, Show)++newtype SrcMap a =+  SrcMap+  { unSrcMap :: Map.Map {- end -} Loc ({- start -} Loc, a)+  } deriving Show++instance Monoid (SrcMap a) where+  mempty = empty+  mappend = union++spanStart, spanEnd :: SrcSpan -> Loc+spanStart = uncurry Loc . srcSpanStart+spanEnd = uncurry Loc . srcSpanEnd++fromSrcLoc :: SrcLoc -> Loc+fromSrcLoc SrcLoc { srcLine = line, srcColumn = col } = Loc line col++insert :: SrcSpan -> a -> SrcMap a -> SrcMap a+insert span value (SrcMap m) =+  SrcMap $ Map.insert (spanEnd span) (spanStart span, value) m++lookup :: SrcLoc -> SrcMap a -> Maybe a+lookup (fromSrcLoc -> loc) (SrcMap map) =+  case Map.split loc map of+    (_less, greater)+      | Map.null greater -> Nothing+      | otherwise ->+        case Map.findMin greater of+         (_, (start, value))+          | start <= loc -> Just value+          | otherwise -> Nothing++union :: SrcMap a -> SrcMap a -> SrcMap a+union (SrcMap a) (SrcMap b) = SrcMap (a `Map.union` b)++empty :: SrcMap a+empty = SrcMap Map.empty++singleton :: SrcSpan -> a -> SrcMap a+singleton span value = insert span value empty
+ Ariadne/Types.hs view
@@ -0,0 +1,32 @@+module Ariadne.Types where++import Language.Haskell.Names+import Language.Haskell.Exts.Annotated+import Distribution.HaskellSuite.Packages+import qualified Distribution.ModuleName as Cabal+import qualified Data.Map as Map++data NameLevel = TypeLevel | ValueLevel+  deriving (Ord, Eq, Show, Enum, Bounded)++-- | Global name index records the correspondence between global names and+-- their definition sites. Not every available global name is necessarily+-- in the index.+type GlobalNameIndex = Map.Map (OrigName, NameLevel) SrcLoc++-- | Data about a module for which we have source code+data ModuleData = ModuleData+  { moduleSource :: Module SrcSpan+  , moduleSymbols :: Symbols+  }++-- | A module collection roughly corresponds to a single Cabal package,+-- although it doesn't have to be cabalized.+--+-- The important thing is that all modules in the collection share the+-- same set of package dependencies (including their versions), and+-- recursive modules have to be in the same collection.+data ModuleCollection = ModuleCollection+  { collectionDeps :: Packages+  , collectionModuleData :: Map.Map Cabal.ModuleName ModuleData+  }
+ LICENSE view
@@ -0,0 +1,20 @@+The MIT License (MIT)++Copyright (c) 2013 Roman Cheplyaka++Permission is hereby granted, free of charge, to any person obtaining a copy of+this software and associated documentation files (the "Software"), to deal in+the Software without restriction, including without limitation the rights to+use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of+the Software, and to permit persons to whom the Software is furnished to do so,+subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS+FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR+COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER+IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN+CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ README.md view
@@ -0,0 +1,94 @@+Ariadne+=======++Ariadne provides a "go-to-definition" functionality for Haskell.++Usage+-----++To use Ariadne, you need two things:++* install this package, `ariadne`, which includes the `ariadne-server`+  executable, and make sure this executable is running;+* find and install a plugin for your editor or IDE of choice.++Editor plugins+--------------++Currently, the following editor/IDE plugins exist:++* [vim](https://github.com/feuerbach/ariadne-vim)++Limitations+-----------++As of v0.1, Ariadne only knows about the current file. It won't find definitions+in other files in the same directory, or in the installed packages. It also+won't look in the Cabal file for the language extensions, and a file may fail to+parse because of that.++These will be addressed in the future versions.++Creating a plugin+-----------------++Writing a new Ariadne plugin should be straightforward (assuming you+know how to extend your editor/IDE).++If you write a new plugin, let me know so I can update the list above, and also+notify you when the protocol changes.++[bert]: http://bert-rpc.org/++### Conventions++In the protocol description below, we don't use Erlang's upper-case/lower-case+convention, because it would confuse anyone except Erlang or Prolog programmers.+Instead, variables and functions are written lowercase, and atoms are prefixed+with the colon, e.g. `:atom`.++### Protocol++You communicate with the Ariadne server via the [BERT-RPC protocol][bert] over+TCP. The server listens on the local TCP port 39014. The BERT-RPC module is+`ariadne`.++The request has form++    find(file, line, column)++where `file` is a binary string, `line` and `column` are integers. `file` must+contain the full path to the Haskell source file. It is assumed to be UTF-8+encoded, although this may improve in the future.++The `line` and `column` should probably be the current cursor position. Ariadne+will look up the name at that location. Lines and columns are numbered starting+from 1.++The possible responses are:++    { :no_name }++This means that there's no recognized name at the+given position. The plugin should probably do nothing in this case.++    { :loc_known, file, line, column }++This means that the name is defined at the given file, line, and column. The+`file` is again a binary UTF-8 encoded full path. The plugin should probably+jump at that location.++    { :loc_unknown, modname }++We don't know where the name is defined, but we know it comes from the given+module (binary UTF-8 encoded name). The plugin may want to show this+information to the user.++    { :error, message }++Some error has occurred. For example, the file has a syntax or scoping error.+The plugin is expected to present the error message to the user.++The message is a binary UTF-8 encoded text, possibly spanning multiple lines.++Other requests and responses will probably be added in the future versions.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ ariadne.cabal view
@@ -0,0 +1,40 @@+-- Initial ariadne.cabal generated by cabal init.  For further+-- documentation, see http://haskell.org/cabal/users-guide/++name:                ariadne+version:             0.1+synopsis:            Go-to-definition for Haskell+description:         See https://github.com/feuerbach/ariadne#ariadne+homepage:            https://github.com/feuerbach/ariadne+license:             MIT+license-file:        LICENSE+author:              Roman Cheplyaka+maintainer:          roma@ro-che.info+-- copyright:+category:            Language+build-type:          Simple+extra-source-files:  README.md+cabal-version:       >=1.10++source-repository head+  type: git+  location: git@github.com:feuerbach/ariadne.git++executable ariadne-server+  main-is: Ariadne.hs+  other-modules:+    Ariadne.GlobalNameIndex+    Ariadne.SrcMap+    Ariadne.Index+    Ariadne.Types+  build-depends:+    base >=4 && <5,+    haskell-names >=0.3,+    haskell-src-exts >=1.14,+    haskell-packages >=0.2,+    mtl >=2.1,+    bert >=1.1,+    utf8-string >=0.3,+    containers >=0.5,+    Cabal >=1.18+  default-language:    Haskell2010