packages feed

psc-ide (empty) → 0.1.0.0

raw patch · 19 files changed

+1050/−0 lines, 19 filesdep +aesondep +basedep +containerssetup-changed

Dependencies added: aeson, base, containers, directory, filepath, hspec, lens, lens-aeson, mtl, network, optparse-applicative, parsec, psc-ide, regex-tdfa, text, wreq

Files

+ LICENSE view
@@ -0,0 +1,21 @@+The MIT License (MIT)++Copyright (c) 2015 Christoph Hegemann and Contributors++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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ lib/PureScript/Ide.hs view
@@ -0,0 +1,125 @@+module PureScript.Ide where++import           Control.Monad.Except+import           Control.Monad.State.Lazy (StateT (..), get, modify)+import qualified Data.Map.Lazy            as M+import           Data.Maybe               (mapMaybe)+import           Data.Monoid+import           Data.Text                (Text ())+import qualified Data.Text  as T+import           PureScript.Ide.Completion+import           PureScript.Ide.Externs+import           PureScript.Ide.Pursuit+import           PureScript.Ide.Error+import           PureScript.Ide.Types+import           System.FilePath+import           System.Directory++type PscIde = StateT PscState IO++getAllDecls :: PscIde [ExternDecl]+getAllDecls = concat . pscStateModules <$> get++getAllModules :: PscIde [Module]+getAllModules = M.toList . pscStateModules <$> get++findCompletions :: [Filter] -> Matcher -> PscIde Success+findCompletions filters matcher =+    CompletionResult <$> getCompletions filters matcher <$> getAllModules++findType :: DeclIdent -> [Filter] -> PscIde Success+findType search filters =+    CompletionResult <$> getExactMatches search filters <$> getAllModules++findPursuitCompletions :: Text -> PscIde [Completion]+findPursuitCompletions = liftIO . searchPursuit++-- TODO: Introduce the Either Monad to clean this up+loadExtern :: FilePath -> PscIde (Either Error ())+loadExtern fp = do+    parseResult <- liftIO $ readExternFile fp+    case parseResult of+        Right decls ->+            case moduleFromDecls decls of+              Right (name, decls') -> Right <$> modify+                   (\x ->+                         x+                         { pscStateModules = M.insert+                               name+                               decls'+                               (pscStateModules x)+                         })+              Left err -> return $ Left err+        Left e -> return . Left . ParseError e $ "The module at" ++ fp ++ "could not be parsed"++getDependenciesForModule :: ModuleIdent -> PscIde (Maybe [ModuleIdent])+getDependenciesForModule m = do+  mDecls <- M.lookup m . pscStateModules <$> get+  return $ mapMaybe getDependencyName <$> mDecls+  where getDependencyName (Dependency dependencyName _) = Just dependencyName+        getDependencyName _ = Nothing++moduleFromDecls :: [ExternDecl] -> Either Error Module+moduleFromDecls decls@(ModuleDecl name _:_) = Right (name, decls)+moduleFromDecls _ = Left (GeneralError "An externs File didn't start with a module declaration")++stateFromDecls :: [[ExternDecl]] -> Either Error PscState+stateFromDecls externs= do+  modules <- mapM moduleFromDecls externs+  return $ PscState (M.fromList modules)++printModules :: PscIde Success+printModules =+    TextResult . T.intercalate ", " . M.keys . pscStateModules <$> get++-- | The first argument is a set of modules to load. The second argument+--   denotes modules for which to load dependencies+loadModulesAndDeps :: [ModuleIdent] -> [ModuleIdent] -> PscIde (Either Error Success)+loadModulesAndDeps mods deps = do+    r1 <- mapM loadModule mods+    r2 <- mapM loadModuleDependencies deps+    return $+        TextResult <$>+        liftM2+            (\x y -> x <> ", " <> y)+            (T.concat <$> sequence r1)+            (T.concat <$> sequence r2)++loadModuleDependencies :: ModuleIdent -> PscIde (Either Error T.Text)+loadModuleDependencies moduleName = do+    _ <- loadModule moduleName+    mDeps <- getDependenciesForModule moduleName+    case mDeps of+        Just deps -> do+            mapM_ loadModule deps+            return (Right ("Dependencies for " <> moduleName <> " loaded."))+        Nothing -> return (Left (ModuleNotFound moduleName))++loadModule :: ModuleIdent -> PscIde (Either Error T.Text)+loadModule mn = do+    path <- liftIO $ filePathFromModule mn+    case path of+        Just p  -> do+          res <- loadExtern p+          case res of+            Right _ -> return (Right $ "Loaded extern file at: " <> T.pack p)+            Left err -> return (Left err)+        Nothing -> return (Left . GeneralError $ "Could not load module " <> T.unpack mn)++filePathFromModule :: ModuleIdent -> IO (Maybe FilePath)+filePathFromModule moduleName = do+    cwd <- getCurrentDirectory+    let path = cwd </> "output" </> T.unpack moduleName </> "externs.purs"+    ex <- doesFileExist path+    return $+        if ex+            then Just path+            else Nothing++-- | Taken from Data.Either.Utils+maybeToEither :: MonadError e m =>+                 e                      -- ^ (Left e) will be returned if the Maybe value is Nothing+              -> Maybe a                -- ^ (Right a) will be returned if this is (Just a)+              -> m a+maybeToEither errorval Nothing = throwError errorval+maybeToEither _ (Just normalval) = return normalval
+ lib/PureScript/Ide/CodecJSON.hs view
@@ -0,0 +1,21 @@+module PureScript.Ide.CodecJSON where++import PureScript.Ide.Externs (ExternDecl(..))+import Data.Aeson+import Data.Text (Text())+import Data.Text.Lazy (toStrict, fromStrict)+import Data.Text.Lazy.Encoding (decodeUtf8, encodeUtf8)++instance ToJSON ExternDecl where+  toJSON (FunctionDecl n t)        = object ["name" .= n, "type" .= t]+  toJSON (ModuleDecl   n t)        = object ["name" .= n, "type" .= t]+  toJSON (DataDecl     n t)        = object ["name" .= n, "type" .= t]+  toJSON (Dependency   n names)    = object ["module" .= n, "names" .= names]+  toJSON (FixityDeclaration f p n) = object ["name" .= n, "fixity" .= show f, "precedence" .= p]++encodeT :: (ToJSON a) => a -> Text+encodeT = toStrict . decodeUtf8 . encode++decodeT :: (FromJSON a) => Text -> Maybe a+decodeT = decode . encodeUtf8 . fromStrict+
+ lib/PureScript/Ide/Command.hs view
@@ -0,0 +1,79 @@+{-# LANGUAGE ScopedTypeVariables #-}+module PureScript.Ide.Command where++import           Control.Monad+import           Data.Aeson+import           Data.Maybe+import           PureScript.Ide.Matcher+import           PureScript.Ide.Filter+import           PureScript.Ide.Types++data Command+    = Load { loadModules      :: [ModuleIdent]+           , loadDependencies :: [ModuleIdent]}+    | Type { typeSearch  :: DeclIdent+           , typeFilters :: [Filter]}+    | Complete { completeFilters :: [Filter]+               , completeMatcher :: Matcher}+    | List+    | Cwd+    | Quit++instance FromJSON Command where+  parseJSON = withObject "command" $ \o -> do+    (command :: String) <- o .: "command"+    case command of+      "list" -> return List+      "cwd"  -> return Cwd+      "quit" -> return Quit+      "load" -> do+        params <- o .: "params"+        mods <- params .:? "modules"+        deps <- params .:? "dependencies"+        return $ Load (fromMaybe [] mods) (fromMaybe [] deps)+      "type" -> do+        params <- o .: "params"+        search <- params .: "search"+        filters <- params .: "filters"+        return $ Type search filters+      "complete" -> do+        params <- o .: "params"+        filters <- params .:? "filters"+        matcher <- params .:? "matcher"+        return $ Complete (fromMaybe [] filters) (fromMaybe (Matcher id) matcher)+      _ -> mzero++instance FromJSON Filter where+  parseJSON = withObject "filter" $ \o -> do+    (filter' :: String) <- o .: "filter"+    case filter' of+      "exact" -> do+        params <- o .: "params"+        search <- params .: "search"+        return $ equalityFilter search+      "prefix" -> do+        params <- o.: "params"+        search <- params .: "search"+        return $ prefixFilter search+      "modules" -> do+        params <- o .: "params"+        modules <- params .: "modules"+        return $ moduleFilter modules+      "dependencies" -> do+        params <- o .: "params"+        deps <- params .: "modules"+        return $ dependencyFilter deps+      _ -> mzero++instance FromJSON Matcher where+  parseJSON = withObject "matcher" $ \o -> do+    (matcher :: Maybe String) <- o .:? "matcher"+    case matcher of+      Just "flex" -> do+        params <- o .: "params"+        search <- params .: "search"+        return $ flexMatcher search+      Just "helm" -> error "Helm matcher not implemented yet."+      Just "distance" -> error "Distance matcher not implemented yet."+      Just _ -> mzero+      Nothing -> return $ Matcher id
+ lib/PureScript/Ide/Completion.hs view
@@ -0,0 +1,34 @@+module PureScript.Ide.Completion+       (getCompletions, getExactMatches)+       where++import           Data.Maybe            (mapMaybe)+import           PureScript.Ide.Filter+import           PureScript.Ide.Types++-- | Applies the CompletionFilters and the Matcher to the given Modules+--   and sorts the found Completions according to the Matching Score+getCompletions :: [Filter] -> Matcher -> [Module] -> [Completion]+getCompletions filters (Matcher matcher) modules =+    matcher $ completionsFromModules (applyFilters filters modules)++getExactMatches :: DeclIdent -> [Filter] -> [Module] -> [Completion]+getExactMatches search filters modules =+    completionsFromModules $+    applyFilters (equalityFilter search : filters) modules++applyFilters :: [Filter] -> [Module] -> [Module]+applyFilters = foldl (\f (Filter g) -> f . g) id++completionsFromModules :: [Module] -> [Completion]+completionsFromModules = concat . fmap completionFromModule++completionFromModule :: Module -> [Completion]+completionFromModule (moduleIdent, decls) =+    mapMaybe go decls+    where+        go (FunctionDecl name type') = Just (Completion (moduleIdent, name, type'))+        go (DataDecl name kind)      = Just (Completion (moduleIdent, name, kind))+        go (ModuleDecl name _)       = Just (Completion ("module", name, "module"))+        go _                         = Nothing+
+ lib/PureScript/Ide/Error.hs view
@@ -0,0 +1,35 @@+module PureScript.Ide.Error+       (ErrorMsg, Error(..), textError)+       where++import           Data.Aeson+import           Data.Monoid+import           Data.Text              (Text, pack)+import           PureScript.Ide.Externs (ModuleIdent)+import qualified Text.Parsec.Error      as P++type ErrorMsg = String++data Error+    = GeneralError ErrorMsg+    | NotFound Text+    | ModuleNotFound ModuleIdent+    | ParseError P.ParseError ErrorMsg+    deriving (Show, Eq)++instance ToJSON Error where+  toJSON err = object+               [+                 "resultType" .= ("error" :: Text),+                 "result" .= textError err+               ]++textError :: Error -> Text+textError (GeneralError msg)           = pack msg+textError (NotFound ident)             = "Symbol '" <> ident <> "' not found."+textError (ModuleNotFound ident)       = "Module '" <> ident <> "' not found."+textError (ParseError parseError msg)  = pack $ msg <> ": " <> show (escape parseError)+    where+    -- escape newlines and other special chars so we can send the error over the socket as a single line+      escape :: P.ParseError -> String+      escape = show
+ lib/PureScript/Ide/Externs.hs view
@@ -0,0 +1,166 @@+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-unused-do-bind #-}++module PureScript.Ide.Externs+  (+    ExternParse,+    ExternDecl(..),+    ModuleIdent,+    DeclIdent,+    Type,+    Fixity(..),+    readExternFile,+    parseExtern,+    parseExternDecl,+    typeParse+  ) where++import           Data.Char            (digitToInt)+import           Data.Text            (Text ())+import qualified Data.Text            as T+import qualified Data.Text.IO         as T+import           PureScript.Ide.Types+import           Text.Parsec+import           Text.Parsec.Text++type ExternParse = Either ParseError [ExternDecl]++-- | Parses an extern file into the ExternDecl format.+readExternFile :: FilePath -> IO ExternParse+readExternFile fp = readExtern . T.lines <$> T.readFile fp++readExtern :: [Text] -> ExternParse+readExtern strs = mapM parseExtern clean+  where+    clean = removeComments strs++removeComments :: [Text] -> [Text]+removeComments = filter (not . T.isPrefixOf "--")++parseExtern :: Text -> Either ParseError ExternDecl+parseExtern = parse parseExternDecl ""++parseExternDecl :: Parser ExternDecl+parseExternDecl =+    try parseDependency <|> try parseFixityDecl <|> try parseFunctionDecl <|>+    try parseDataDecl <|>+    try parseModuleDecl <|>+    return (ModuleDecl "" [])++parseDependency :: Parser ExternDecl+parseDependency =+    try parseQualifiedImport <|> try parseHidingImport <|> try parseSpecifyingImport+    <|> parseSimpleImport++parseSimpleImport :: Parser ExternDecl+parseSimpleImport = do+    string "import"+    module' <- identifier+    eof+    return $ Dependency module' []++parseSpecifyingImport :: Parser ExternDecl+parseSpecifyingImport = do+    string "import"+    module' <- identifier+    char '('+    names <- sepBy identifier (char ',')+    char ')'+    eof+    return $ Dependency module' names++parseHidingImport :: Parser ExternDecl+parseHidingImport = do+    string "import"+    module' <- identifier+    string "hiding"+    spaces+    char '('+    hiddenNames <- sepBy identifier (char ',')+    char ')'+    eof+    return $ Dependency module' []++parseQualifiedImport :: Parser ExternDecl+parseQualifiedImport = do+    string "import qualified"+    module' <- identifier+    string "as"+    qualifier <- identifier+    eof+    return $ Dependency module' []++parseFixityDecl :: Parser ExternDecl+parseFixityDecl = do+    fixity <- parseFixity+    spaces+    priority <- digitToInt <$> digit+    spaces+    symbol <- many1 anyChar+    eof+    return (FixityDeclaration fixity priority (T.pack symbol))++parseFixity :: Parser Fixity+parseFixity =+    (try (string "infixr") >> return Infixr) <|>+    (try (string "infixl") >> return Infixl) <|>+    (string "infix" >> return Infix)++parseFunctionDecl :: Parser ExternDecl+parseFunctionDecl = do+    string "foreign import"+    spaces+    (name, type') <- parseType+    eof+    return (FunctionDecl (T.pack name) (T.pack type'))++parseDataDecl :: Parser ExternDecl+parseDataDecl = parseDataDecl' <|> parseForeignDataDecl++parseDataDecl' :: Parser ExternDecl+parseDataDecl' = do+  string "data"+  ident <- identifier+  kind <- many anyChar+  return (DataDecl ident (T.pack kind))++parseForeignDataDecl :: Parser ExternDecl+parseForeignDataDecl = do+  string "foreign import data"+  spaces+  (name, kind) <- parseType+  eof+  return $ DataDecl (T.pack name) (T.pack kind)++parseModuleDecl :: Parser ExternDecl+parseModuleDecl = do+  string "module"+  name <- identifier+  exports <- identifierList+  return (ModuleDecl name exports)++parseType :: Parser (String, String)+parseType = do+  name <- identifier+  string "::"+  spaces+  type' <- many1 anyChar+  return (T.unpack name, type')++typeParse :: Text -> Either Text (Text, Text)+typeParse t = case parse parseType "" t of+  Right (x,y) -> Right (T.pack x, T.pack y)+  Left err -> Left (T.pack (show err))++identifierList :: Parser [Text]+identifierList = between (char '(') (char ')') (sepBy identifier (char ','))++identifier :: Parser Text+identifier = do+    spaces+    ident <-+        -- necessary for being able to parse the following ((++), concat)+        between (char '(') (char ')') (many1 (noneOf ", )")) <|>+        many1 (noneOf ", )")+    spaces+    return (T.pack ident)
+ lib/PureScript/Ide/Filter.hs view
@@ -0,0 +1,70 @@+module PureScript.Ide.Filter+       (moduleFilter, prefixFilter, equalityFilter, dependencyFilter,+        runFilter)+       where++import           Data.Maybe           (mapMaybe, listToMaybe)+import           Data.Text            (Text, isPrefixOf)+import           PureScript.Ide.Types++-- | Only keeps the given Modules+moduleFilter :: [ModuleIdent] -> Filter+moduleFilter =+    Filter . moduleFilter'++moduleFilter' :: [ModuleIdent] -> [Module] -> [Module]+moduleFilter' moduleIdents = filter (flip elem moduleIdents . fst)++-- | Only keeps the given Modules and all of their dependencies+dependencyFilter :: [ModuleIdent] -> Filter+dependencyFilter = Filter . dependencyFilter'++dependencyFilter' :: [ModuleIdent] -> [Module] -> [Module]+dependencyFilter' moduleIdents mods =+  moduleFilter' (concatMap (getDepForModule mods) moduleIdents) mods+  where+    getDepForModule :: [Module] -> ModuleIdent -> [ModuleIdent]+    getDepForModule ms moduleIdent =+      moduleIdent : maybe [] extractDeps (findModule moduleIdent ms)++    findModule :: ModuleIdent -> [Module] -> Maybe Module+    findModule i ms = listToMaybe $ filter go ms+      where go (mn, _) = i == mn++    extractDeps :: Module -> [ModuleIdent]+    extractDeps = mapMaybe extractDep . snd+      where extractDep (Dependency n _) = Just n+            extractDep _ = Nothing++-- | Only keeps Identifiers that start with the given prefix+prefixFilter :: Text -> Filter+prefixFilter "" = Filter id+prefixFilter t = Filter $ identFilter prefix t+  where+    prefix :: ExternDecl -> Text -> Bool+    prefix (FunctionDecl name _) search = search `isPrefixOf` name+    prefix (DataDecl name _) search = search `isPrefixOf` name+    prefix (ModuleDecl name _) search = search `isPrefixOf` name+    prefix _ _ = False+++-- | Only keeps Identifiers that are equal to the search string+equalityFilter :: Text -> Filter+equalityFilter = Filter . identFilter equality+  where+    equality :: ExternDecl -> Text -> Bool+    equality (FunctionDecl name _) prefix = prefix == name+    equality (DataDecl name _) prefix = prefix == name+    equality _ _ = False+++identFilter :: (ExternDecl -> Text -> Bool ) -> Text -> [Module] -> [Module]+identFilter predicate search =+    filter (not . null . snd) . fmap filterModuleDecls+  where+    filterModuleDecls :: Module -> Module+    filterModuleDecls (moduleIdent,decls) =+        (moduleIdent, filter (`predicate` search) decls)++runFilter :: Filter -> [Module] -> [Module]+runFilter (Filter f) = f
+ lib/PureScript/Ide/Matcher.hs view
@@ -0,0 +1,57 @@+module PureScript.Ide.Matcher (flexMatcher, runMatcher) where++import           Data.Function        (on)+import           Data.List            (sortBy)+import           Data.Maybe           (mapMaybe)+import qualified Data.Text            as T+import qualified Data.Text.Encoding   as TE+import           PureScript.Ide.Types+import           Text.Regex.TDFA      ((=~))+++type ScoredCompletion = (Double, Completion)++-- | Matches any occurence of the search string with intersections+-- |+-- | The scoring measures how far the matches span the string where+-- | closer is better.+-- | Examples:+-- |   flMa matches flexMatcher. Score: 14.28+-- |   sons matches sortCompletions. Score: 6.25+flexMatcher :: T.Text -> Matcher+flexMatcher pattern = mkMatcher (flexMatch pattern)++mkMatcher :: ([Completion] -> [ScoredCompletion]) -> Matcher+mkMatcher matcher = Matcher $ fmap snd . sortCompletions . matcher+++runMatcher :: Matcher -> [Completion] -> [Completion]+runMatcher (Matcher m) = m++sortCompletions :: [ScoredCompletion] -> [ScoredCompletion]+sortCompletions = sortBy (flip compare `on` fst)++flexMatch :: T.Text -> [Completion] -> [ScoredCompletion]+flexMatch pattern = mapMaybe (flexRate pattern)++flexRate :: T.Text -> Completion -> Maybe ScoredCompletion+flexRate pattern c@(Completion (_,ident,_)) =+    (,) <$> flexScore pattern ident <*> pure c++-- FlexMatching ala Sublime.+-- Borrowed from: http://cdewaka.com/2013/06/fuzzy-pattern-matching-in-haskell/+--+-- By string =~ pattern we'll get the start of the match and the length of+-- the matchas a (start, length) tuple if there's a match.+-- If match fails then it would be (-1,0)+flexScore :: T.Text -> DeclIdent -> Maybe Double+flexScore "" _ = Nothing+flexScore pat str =+    case TE.encodeUtf8 str =~ TE.encodeUtf8 pat' :: (Int, Int) of+        (-1,0) -> Nothing+        (start,len) -> Just $ calcScore start (start + len)+  where+    Just (first, pattern) = T.uncons pat+    pat' = first `T.cons` T.concatMap (T.snoc ".*") pattern+    calcScore start end =+        100.0 / fromIntegral ((1 + start) * (end - start + 1))
+ lib/PureScript/Ide/Pursuit.hs view
@@ -0,0 +1,33 @@+{-# LANGUAGE OverloadedStrings #-}+module PureScript.Ide.Pursuit where++import           Control.Lens+import           Data.Aeson.Lens+import           Data.Either+import           Data.Monoid+import           Data.Text              (Text)+import qualified Data.Text              as T+import           Network.Wreq+import           PureScript.Ide.Types+import           PureScript.Ide.Externs (typeParse)++queryUrl :: Text+queryUrl = "http://pursuit.purescript.org/search?q="++jsonOpts :: Options+jsonOpts = defaults & header "Accept" .~ ["application/json"]++myZip :: [a] -> [(b, c)] -> [(a, b, c)]+myZip = zipWith (\a (b, c) -> (a, b, c))++searchPursuit :: Text -> IO [Completion]+searchPursuit query = do+    r <- getWith jsonOpts (T.unpack $ queryUrl <> query)+    let texts = r ^.. responseBody . values . key "text" . _String+    let moduleNames = r ^..+                      responseBody .+                      values .+                      key "info" .+                      key "module" .+                      _String+    return . fmap Completion . myZip moduleNames . rights $ typeParse <$> texts
+ lib/PureScript/Ide/Types.hs view
@@ -0,0 +1,69 @@+module PureScript.Ide.Types where++import           Control.Monad+import           Data.Aeson+import           Data.Map.Lazy as M+import           Data.Text     (Text ())++type ModuleIdent = Text+type DeclIdent   = Text+type Type        = Text++data Fixity = Infix | Infixl | Infixr deriving(Show, Eq)++data ExternDecl+    = FunctionDecl { functionName :: DeclIdent+                   , functionType :: Type}+    | FixityDeclaration Fixity+                        Int+                        DeclIdent+    | Dependency { dependencyModule :: ModuleIdent+                 , dependencyNames  :: [Text]}+    | ModuleDecl ModuleIdent+                 [DeclIdent]+    | DataDecl DeclIdent+               Text+    deriving (Show,Eq)++type Module = (ModuleIdent, [ExternDecl])++data PscState = PscState+    { pscStateModules :: M.Map Text [ExternDecl]+    } deriving (Show,Eq)++emptyPscState :: PscState+emptyPscState = PscState M.empty++newtype Completion =+    Completion (ModuleIdent, DeclIdent, Type)+    deriving (Show,Eq)++instance FromJSON Completion where+  parseJSON (Object o) = do+    m <- o .: "module"+    d <- o .: "identifier"+    t <- o .: "type"+    return $ Completion (m, d, t)+  parseJSON _ = mzero++instance ToJSON Completion where+  toJSON (Completion (m, d, t)) =+    object ["module" .= m, "identifier" .= d, "type" .= t]++data Success =+  CompletionResult [Completion]+  | TextResult Text+    deriving(Show, Eq)++encodeSuccess :: (ToJSON a) => a -> Value+encodeSuccess res = object+                    [+                      "resultType" .= ("success" :: Text),+                      "result" .= res+                    ]+instance ToJSON Success where+  toJSON (CompletionResult cs) = encodeSuccess cs+  toJSON (TextResult t) = encodeSuccess t++newtype Filter  = Filter ([Module] -> [Module])+newtype Matcher = Matcher ([Completion] -> [Completion])
+ psc-ide.cabal view
@@ -0,0 +1,77 @@+name:                psc-ide+version:             0.1.0.0+synopsis:            Language support for the PureScript programming language+description:         Please see README.md+homepage:            http://github.com/kRITZCREEK/psc-ide+license:             MIT+license-file:        LICENSE+author:              Christoph Hegemann+maintainer:          christoph.hegemann1337@gmail.com+copyright:           2015 Christoph Hegemann+category:            PureScript, Development+build-type:          Simple+cabal-version:       >=1.10++library+  hs-source-dirs:        lib+  exposed-modules:       PureScript.Ide+                       , PureScript.Ide.Command+                       , PureScript.Ide.Externs+                       , PureScript.Ide.Error+                       , PureScript.Ide.CodecJSON+                       , PureScript.Ide.Pursuit+                       , PureScript.Ide.Completion+                       , PureScript.Ide.Matcher+                       , PureScript.Ide.Filter+                       , PureScript.Ide.Types+  default-language:      Haskell2010+  build-depends:         aeson+                       , base >= 4.7 && < 5+                       , containers+                       , lens+                       , lens-aeson+                       , mtl+                       , parsec+                       , directory+                       , filepath+                       , regex-tdfa+                       , text+                       , wreq+  default-extensions:    OverloadedStrings++executable psc-ide+  hs-source-dirs:      src+  main-is:             Main.hs+  default-language:    Haskell2010+  build-depends:       base >= 4.7 && < 5+                     , psc-ide+                     , mtl+                     , text+                     , optparse-applicative+                     , network++executable psc-ide-server+  hs-source-dirs:      server+  main-is:             Main.hs+  default-language:    Haskell2010+  ghc-options:         -threaded+  build-depends:     base >= 4.7 && < 5+                   , mtl+                   , network+                   , optparse-applicative+                   , directory+                   , psc-ide+                   , text++test-suite spec+  type:                exitcode-stdio-1.0+  ghc-options:         -Wall+  hs-source-dirs:      test+  default-language:    Haskell2010+  main-is:             Spec.hs+  other-modules:       PureScript.Ide.ExternsSpec+                     , PureScript.Ide.FilterSpec+                     , PureScript.Ide.MatcherSpec+  build-depends:       base    >= 4.7 && < 5+                     , psc-ide+                     , hspec
+ server/Main.hs view
@@ -0,0 +1,99 @@+{-# LANGUAGE OverloadedStrings #-}+module Main where++import           Control.Monad+import           Control.Exception         (bracketOnError)+import           Control.Monad.State.Lazy+import           Data.Maybe                (fromMaybe)+import qualified Data.Text                 as T+import qualified Data.Text.IO              as T+import           Network                   hiding (socketPort)+import           Network.BSD               (getProtocolNumber)+import           Network.Socket            hiding (PortNumber, Type, accept,+                                            sClose)+import           Options.Applicative+import           PureScript.Ide+import           PureScript.Ide.CodecJSON+import           PureScript.Ide.Command+import           PureScript.Ide.Error+import           PureScript.Ide.Types+import           System.Directory+import           System.Exit+import           System.IO++-- Copied from upstream impl of listenOn+-- bound to localhost interface instead of iNADDR_ANY+listenOnLocalhost :: PortID -> IO Socket+listenOnLocalhost (PortNumber port) = do+    proto <- getProtocolNumber "tcp"+    localhost <- inet_addr "127.0.0.1"+    bracketOnError+        (socket AF_INET Stream proto)+        sClose+        (\sock ->+              do setSocketOption sock ReuseAddr 1+                 bindSocket sock (SockAddrInet port localhost)+                 listen sock maxListenQueue+                 return sock)+listenOnLocalhost _ = error "Wrong Porttype"++data Options = Options+    { optionsDirectory :: Maybe FilePath+    , optionsPort      :: Maybe Int+    , optionsDebug     :: Bool+    }++main :: IO ()+main = do+    Options dir port debug <- execParser opts+    maybe (return ()) setCurrentDirectory dir+    startServer (PortNumber . fromIntegral $ fromMaybe 4242 port) debug emptyPscState+  where+    parser =+        Options <$>+          optional (strOption (long "directory" <> short 'd')) <*>+          optional (option auto (long "port" <> short 'p')) <*>+          switch (long "debug")+    opts = info parser mempty+++startServer :: PortID -> Bool -> PscState -> IO ()+startServer port debug st_in =+    withSocketsDo $+    do sock <- listenOnLocalhost port+       evalStateT (forever (loop sock)) st_in+  where+    acceptCommand sock = do+        (h,_,_) <- accept sock+        hSetEncoding h utf8+        cmd <- T.hGetLine h+        when debug (T.putStrLn cmd)+        return (cmd, h)+    loop :: Socket -> PscIde ()+    loop sock = do+        (cmd,h) <- liftIO $ acceptCommand sock+        case decodeT cmd of+            Just cmd' -> do+                result <- handleCommand cmd'+                when debug $ liftIO $ T.putStrLn ("Answer was: " <> (T.pack . show $ result))+                case result of+                  -- What function can I use to clean this up?+                  Right r  -> liftIO $ T.hPutStrLn h (encodeT r)+                  Left err -> liftIO $ T.hPutStrLn h (encodeT err)+            Nothing ->+                liftIO $ T.hPutStrLn h $ encodeT (GeneralError "Error parsing Command.")+        liftIO $ hClose h++handleCommand :: Command -> PscIde (Either Error Success)+handleCommand (Load modules deps) =+    loadModulesAndDeps modules deps+handleCommand (Type search filters) =+    Right <$> findType search filters+handleCommand (Complete filters matcher) =+    Right <$> findCompletions filters matcher+handleCommand List =+    Right <$> printModules+handleCommand Cwd =+    Right . TextResult . T.pack <$> liftIO getCurrentDirectory+handleCommand Quit = Right <$> liftIO exitSuccess+
+ src/Main.hs view
@@ -0,0 +1,41 @@+{-# LANGUAGE OverloadedStrings #-}+module Main where++import           Control.Exception+import           Data.Maybe          (fromMaybe)+import qualified Data.Text           as T+import qualified Data.Text.IO        as T+import           Network+import           Options.Applicative+import           System.IO+import           System.Exit++data Options = Options+    { optionsPort :: Maybe Int+    }++main :: IO ()+main = do+    Options port <- execParser opts+    let port' = PortNumber . fromIntegral $ fromMaybe 4242 port+    client port'+  where+    parser =+        Options <$> optional (option auto (long "port" <> short 'p'))+    opts = info parser mempty++client :: PortID -> IO ()+client port = do+    h <-+        connectTo "localhost" port `catch`+        (\(SomeException _) ->+              putStrLn+                  ("Couldn't connect to psc-ide-server on port: " +++                   show port) >>+              exitFailure)+    cmd <- T.getLine+    T.hPutStrLn h cmd+    res <- T.hGetLine h+    putStrLn (T.unpack res)+    hFlush stdout+    hClose h
+ test/PureScript/Ide/ExternsSpec.hs view
@@ -0,0 +1,39 @@+{-# LANGUAGE OverloadedStrings #-}++module PureScript.Ide.ExternsSpec where++import           PureScript.Ide.Externs+import           Test.Hspec++spec :: Spec+spec = do+    describe "Parsing imports" $ do+        it "parses a simple import statement" $+            parseExtern "import Data.Array" `shouldBe`+              Right (Dependency "Data.Array" [])+        it "parses a simple import statement" $+            parseExtern "import Data.Text (functionName, (++))" `shouldBe`+              Right (Dependency "Data.Text" ["functionName", "++"])+        it "parses a hiding import statement" $+            parseExtern "import Prelude hiding (wasd)" `shouldBe`+              Right (Dependency "Prelude" [])+        it "parses a qualified import statement" $+            parseExtern "import qualified Data.Text as T" `shouldBe`+              Right (Dependency "Data.Text" [])+    describe "Parsing modules" $+        it "parses a module declaration" $+            parseExtern "module My.Module (exportedFunction) where" `shouldBe`+              Right (ModuleDecl "My.Module" ["exportedFunction"])+    describe "Parsing functions" $+        it "parses a function declaration" $+            parseExtern "foreign import text :: forall eff s t. Prim.String -> SYM.Component eff s t"+              `shouldBe` Right (FunctionDecl "text" "forall eff s t. Prim.String -> SYM.Component eff s t")+    describe "Parsing Data Declaration" $ do+        it "parses a data declaration" $+            parseExtern "data Handler (eff :: # !) (s :: *)" `shouldBe`+              Right (DataDecl "Handler" "(eff :: # !) (s :: *)")+        it "parses a foreign data declaration" $+            parseExtern "foreign import data STArray :: * -> * -> *" `shouldBe`+              Right (DataDecl "STArray" "* -> * -> *")++
+ test/PureScript/Ide/FilterSpec.hs view
@@ -0,0 +1,53 @@+{-# LANGUAGE OverloadedStrings #-}+module PureScript.Ide.FilterSpec where++import Test.Hspec+import PureScript.Ide.Filter+import PureScript.Ide.Types++modules :: [Module]+modules =+  [+    ("Module.A", [FunctionDecl "function1" ""]),+    ("Module.B", [DataDecl "data1" ""]),+    ("Module.C", [ModuleDecl "Module.C" []]),+    ("Module.D", [Dependency "Module.C" [], FunctionDecl "asd" ""])+  ]++runEq s = runFilter (equalityFilter s) modules+runPrefix s = runFilter (prefixFilter s) modules+runModule ms = runFilter (moduleFilter ms) modules+runDependency ms = runFilter (dependencyFilter ms) modules++spec = do+  describe "equality Filter" $ do+    it "removes empty modules" $+      runEq "test" `shouldBe` []+    it "keeps function declarations that are equal" $+      runEq "function1" `shouldBe` [head modules]+    -- TODO: It would be more sensible to match Constructors+    it "keeps data declarations that are equal" $+      runEq "data1" `shouldBe` [modules !! 1]+  describe "prefixFilter" $ do+    it "keeps everything on empty string" $+      runPrefix "" `shouldBe` modules+    it "keeps functionname prefix matches" $+      runPrefix "fun" `shouldBe` [head modules]+    it "keeps data decls prefix matches" $+      runPrefix "dat" `shouldBe` [modules !! 1]+    it "keeps module decl prefix matches" $+      runPrefix "Mod" `shouldBe` [modules !! 2]+  describe "moduleFilter" $ do+    it "removes everything on empty input" $+      runModule [] `shouldBe` []+    it "only keeps the specified modules" $+      runModule ["Module.A", "Module.C"] `shouldBe` [head modules, modules !! 2]+    it "ignores modules that are not in scope" $+      runModule ["Module.A", "Module.C", "Unknown"] `shouldBe` [head modules, modules !! 2]+  describe "dependencyFilter" $ do+    it "removes everything on empty input" $+      runDependency [] `shouldBe` []+    it "only keeps the specified modules if they have no imports" $+      runDependency ["Module.A", "Module.B"] `shouldBe` [head modules, modules !! 1]+    it "keeps the specified modules and their imports" $+      runDependency ["Module.A", "Module.D"] `shouldBe` [head modules, modules !! 2, modules !! 3]
+ test/PureScript/Ide/MatcherSpec.hs view
@@ -0,0 +1,28 @@+{-# LANGUAGE OverloadedStrings #-}++module PureScript.Ide.MatcherSpec where++import Test.Hspec+import PureScript.Ide.Matcher+import PureScript.Ide.Types++completions :: [Completion]+completions = [+  Completion ("", "firstResult", ""),+  Completion ("", "secondResult", ""),+  Completion ("", "fiult", "")+  ]++mkResult :: [Int] -> [Completion]+mkResult = map (completions !!)++runFlex s = runMatcher (flexMatcher s) completions++spec = do+  describe "Flex Matcher" $ do+    it "doesn't match on an empty string" $+       runFlex "" `shouldBe` []+    it "matches on equality" $+      runFlex "firstResult" `shouldBe` mkResult [0]+    it "scores short matches higher and sorts accordingly" $+      runFlex "filt" `shouldBe` mkResult [2, 0]
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}