fpco-api 1.0.5 → 1.1.0
raw patch · 9 files changed
+96/−87 lines, 9 filesdep +inidep +scientificdep −ConfigFiledep ~aesondep ~http-conduitdep ~network
Dependencies added: ini, scientific
Dependencies removed: ConfigFile
Dependency ranges changed: aeson, http-conduit, network, unordered-containers
Files
- fpco-api.cabal +14/−11
- src/executables/Main.hs +23/−34
- src/library/FP/API/Convert.hs +18/−0
- src/library/FP/API/Run.hs +10/−11
- src/library/FP/API/Types.hs +3/−7
- src/library/FP/Server.hs +17/−17
- src/library/FP/Server/Config.hs +5/−1
- src/library/FP/Server/Spans.hs +2/−2
- src/library/FP/Server/Types.hs +4/−4
fpco-api.cabal view
@@ -1,5 +1,5 @@ name: fpco-api-version: 1.0.5+version: 1.1.0 synopsis: Simple interface to the FP Complete IDE API. description: A server and library for communicating with the FP Complete IDE API. homepage: https://www.fpcomplete.com/page/api@@ -22,13 +22,14 @@ FP.Server.Spans, FP.API.Convert other-modules: FP.API.TH, FFI default-language: Haskell2010- build-depends: base >=4 && < 5,- aeson >=0.6,+ build-depends: scientific >= 0.2.0.1,+ base >=4 && < 5,+ aeson >= 0.6.2.0, bytestring >= 0.9,- ConfigFile >=1.1,+ ini >= 0.2.0, data-default >=0.5, text >=0.11,- network >=2.4,+ network >=2.3, optparse-applicative >=0.5, safe >=0.3, directory >=1.1,@@ -39,7 +40,7 @@ monad-logger >=0.3, mtl >=2.1, containers >= 0.4,- http-conduit == 1.9.*,+ http-conduit >= 1.9.6, texts >=0.3, ghc-prim, template-haskell >=2.7,@@ -64,16 +65,18 @@ default-extensions: CPP hs-source-dirs: src/executables default-language: Haskell2010- build-depends: base >=4 && < 5,+ build-depends: scientific >= 0.2.0.1,+ base >=4 && < 5, fpco-api, optparse-applicative >= 0.5, bytestring >= 0.9,- network >=2.4,+ network >=2.3, safe >=0.3,- aeson >=0.6,+ aeson >=0.6.2.0, text >=0.11, directory >=1.1, filepath >=1.3,- ConfigFile >=1.1,+ ini >=0.2.0, data-default >=0.5,- process >= 1.1+ process >= 1.1,+ unordered-containers >= 0.2.3
src/executables/Main.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE NoMonomorphismRestriction #-} {-# LANGUAGE OverloadedStrings #-}@@ -11,20 +12,22 @@ import FP.Server.Types import FP.Server.Spans -- import Control.Exception import Control.Monad import Data.Aeson import qualified Data.ByteString.Lazy as L-import Data.ConfigFile+ import Data.Default++import qualified Data.HashMap.Strict as M+import Data.Ini import Data.List import Data.Maybe import Data.Monoid import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.IO as T+import Data.Text.Read import Network import Options.Applicative import Prelude hiding (catch)@@ -248,24 +251,16 @@ return () where prompt p = do putStr ("Please enter " ++ p ++ ": ")- getLine+ T.getLine -- | Write out a configuration. writeConfig :: FilePath -> Config -> IO ()-writeConfig fp config =- either (error . show)- (writeFile fp)- cp-- where cp = fmap (to_string :: ConfigParser -> String)- (write emptyCP)- write = addSection "API" >=>- addSection "SERVER" >=>- setValue "API" "token" (configToken config) >=>- setValue "API" "url" (configUrl config) >=>- setValue "SERVER" "port" (show (configPort config))- addSection = flip add_section- setValue spec key v c = set c spec key v+writeConfig fp Config{..} =+ writeIniFile+ fp+ (Ini (M.fromList [("SERVER",M.fromList [("port",T.pack (show configPort))])+ ,("API",M.fromList [("token",configToken)+ ,("url",configUrl)])])) -- | Run a command with the configuration, if there is one and make -- one if there is not.@@ -275,8 +270,8 @@ fp <- getConfigPath mfp exists <- doesFileExist fp if exists- then do contents <- readFile fp- case readConfig agent contents of+ then do ini <- readIniFile fp+ case ini >>= readConfig agent of Left cperr -> error cperr Right config -> cont config else do putStrLn ("No configuration found at " ++ fp)@@ -290,17 +285,11 @@ return (fromMaybe defp mfp) -- | Read the configuration file.-readConfig :: Monad m => Maybe Text -> String -> m Config-readConfig agent contents = do- case config of- Left cperr -> error $ show cperr- Right config' -> return config'-- where config = do- c <- readstring emptyCP contents- Config <$> get c "API" "token"- <*> get c "API" "url"- <*> get c "SERVER" "port"- <*> pure (fromMaybe (configAgent def) agent)- <*> pure (configDebug def)- <*> pure (configStartServer def)+readConfig :: Maybe Text -> Ini -> Either String Config+readConfig agent ini = do+ Config <$> lookupValue "API" "token" ini+ <*> lookupValue "API" "url" ini+ <*> readValue "SERVER" "port" decimal ini+ <*> pure (fromMaybe (configAgent def) agent)+ <*> pure (configDebug def)+ <*> pure (configStartServer def)
src/library/FP/API/Convert.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternGuards #-}@@ -30,6 +31,9 @@ import Numeric import Safe import qualified Text.Show.Pretty as Show+#if MIN_VERSION_aeson(0,7,0)+import Data.Scientific+#endif -------------------------------------------------------------------------------- -- The conversion functions.@@ -69,8 +73,13 @@ int = convertInt value -- Number converters+#if MIN_VERSION_aeson(0,7,0)+ convertDouble = fmap (Number . fromFloatDigits) . pDouble+ convertInt = fmap (Number . fromInteger) . pInt+#else convertDouble = fmap (Number . D) . pDouble convertInt = fmap (Number . I) . pInt+#endif -- Number parsers pDouble :: Show.Value -> Maybe Double@@ -193,9 +202,18 @@ -- | Parse a number. parseNumber :: Value -> Maybe Number+#if MIN_VERSION_aeson(0,7,0) parseNumber value = case value of+ Number n+ | base10Exponent n >= 0 -> return . I . round $ n+ | otherwise -> return . D . fromRational . toRational $ n+ _ -> mzero+#else+parseNumber value = case value of Number n -> return n _ -> mzero+#endif+ -- | Parse a bool. parseBool :: Value -> Maybe Bool
src/library/FP/API/Run.hs view
@@ -16,7 +16,7 @@ import FP.API.Convert import FP.API.Types -import Control.Exception+import Control.Exception as E import Control.Failure import Control.Monad.Extra import Control.Monad.Logger@@ -27,18 +27,17 @@ import Data.Data import Data.IORef import Data.Monoid-import Data.String import Data.Text (Text) import qualified Data.Text as T import Data.Text.Encoding (encodeUtf8) import Language.Fay.Yesod (Returns (..)) import Network.HTTP.Conduit import Network.HTTP.Types.Status-import Prelude hiding (catch)+import Prelude import Texts.English -- | Only used internally for encoding.-data Command = IdeCommand IdeCommand+data Command = IdeCommand !IdeCommand deriving Show -- | Monad that can get info for sending commands.@@ -47,11 +46,11 @@ -- | Simple command configuration. data ClientConfig = CC- { ccUrl :: String- , ccToken :: String- , ccManager :: Manager- , ccCookie :: IORef CookieJar- , ccUserAgent :: Text+ { ccUrl :: !Text+ , ccToken :: !Text+ , ccManager :: !Manager+ , ccCookie :: !(IORef CookieJar)+ , ccUserAgent :: !Text } data CommandException@@ -67,7 +66,7 @@ runCommand :: (MonadLogger m,MonadClient m,Data a,Show a) => (Returns' a -> IdeCommand) -> m a runCommand cmd = do CC{..} <- getClientConfig- request <- parseUrl (ccUrl <> "/fay-command")+ request <- parseUrl (T.unpack (ccUrl <> "/fay-command")) jar <- io $ readIORef ccCookie let req = urlEncodedBody params $ setup ccToken request (Just jar) ccUserAgent $(logDebug) ("=> " <> trunc (T.pack (show (IdeCommand (cmd Returns)))))@@ -93,7 +92,7 @@ , requestHeaders = requestHeaders req ++ [("Accept","application/json") ,("User-Agent",encodeUtf8 ("fpco-api:" <> agent))- ,("authorization","token " <> fromString token)]+ ,("authorization",encodeUtf8 ("token " <> token))] , responseTimeout = Nothing , cookieJar = jar }
src/library/FP/API/Types.hs view
@@ -198,7 +198,7 @@ deriving (Read, Typeable, Data, Show, Eq) -- TODO: middle text should be the code that the type comes from.-data TypeInfo = TypeInfo SourceSpan Text [Text]+data TypeInfo = TypeInfo SourceSpan Text Text deriving (Read, Typeable, Data, Show, Eq) data MaybeText = NoText | JustText Text -- FAY BUG@@ -554,11 +554,7 @@ -- Isolation-runner ids data CompileId = CompileId { unCompileId :: Int }- deriving (Read, Typeable, Data, Show, Eq-#ifndef FAY- , Ord-#endif- )+ deriving (Read, Typeable, Data, Show, Eq) data ProcId = ProcId { unProcId :: Int } deriving (Read, Typeable, Data, Show, Eq)@@ -617,7 +613,7 @@ | ProcessOutputError Text | StatusSnapshot ProjectStatusSnapshot StatusHash | IdInfoResults IdInfo- | SubExprsResults SourceSpan [TypeInfo]+ | SubExprsResults SourceSpan [[TypeInfo]] | AutoCompleteResults (Maybe AutoCompleteInput) [Text] | ImportedPackagesResults [PackageId] | SearchResults [SearchResult]
src/library/FP/Server.hs view
@@ -17,7 +17,7 @@ import Control.Applicative import Control.Concurrent.Lifted-import Control.Exception.Lifted hiding (handle)+import Control.Exception.Lifted as E hiding (handle) import Control.Monad.Extra import Control.Monad.Logger import Control.Monad.Reader@@ -37,7 +37,7 @@ import Data.Typeable import Network import Network.HTTP.Conduit-import Prelude hiding (span,catch)+import Prelude hiding (span) import System.Directory import System.FilePath import System.IO@@ -46,7 +46,7 @@ -- | Run the given Server command with the config. Good for testing in the repl. runWithConfig :: Server b -> Config -> IO b runWithConfig m config = do- manager <- newManager def+ manager <- newManager conduitManagerSettings pollers <- newMVar mempty jar <- newIORef mempty tokensVar <- newMVar mempty@@ -71,7 +71,7 @@ io (hSetBuffering stdout NoBuffering) sock <- io (listenOn (PortNumber (fromIntegral configPort))) $(logInfo) ("Server started on port " <> pack (show configPort) <>- ", remote URL is: " <> pack configUrl)+ ", remote URL is: " <> configUrl) (if forkOnceListening then void . fork else id) (forever (acceptConnection sock)) @@ -278,7 +278,7 @@ (\_ msg -> do case msg of SubExprsResults span' infos- | span' == span -> do reply h (ReplyTypeInfo (map toSpanType infos))+ | span' == span -> do reply h (ReplyTypeInfo (map toSpanType (concat infos))) return Done _ -> return NotDone)) @@ -294,16 +294,16 @@ let fname = FayFileName (pack filename) token <- getToken tokensVar fpid root filename text <- io (T.readFile (root </> filename))- catch (do SaveFileOutput token' _ <- saveFile fname text token fpid- updateToken tokensVar root filename token'- reply h (ReplySaveStatus False))- -- A command exception will be thrown when the file is out of- -- date. So we just immediately grab the new version of the- -- file, overwrite out local copy. Emacs will prompt the user- -- about it at the right time.- (\(_ :: CommandException) ->- do updateFileContents tokensVar fpid root filename- reply h (ReplySaveStatus True)))+ E.catch (do SaveFileOutput token' _ <- saveFile fname text token fpid+ updateToken tokensVar root filename token'+ reply h (ReplySaveStatus False))+ -- A command exception will be thrown when the file is out of+ -- date. So we just immediately grab the new version of the+ -- file, overwrite out local copy. Emacs will prompt the user+ -- about it at the right time.+ (\(_ :: CommandException) ->+ do updateFileContents tokensVar fpid root filename+ reply h (ReplySaveStatus True))) -- | Check the given module. Necessary for flycheck. checkModule :: Handle -> FayProjectId -> FilePath -> FilePath -> FilePath -> Server ()@@ -493,8 +493,8 @@ getFayProjectId = either getProjectId return -- | Strip the trailing slash.-stripSlash :: String -> String-stripSlash = reverse . dropWhile (=='/') . reverse+stripSlash :: Text -> Text+stripSlash = T.reverse . T.dropWhile (=='/') . T.reverse -- | Convert an API message to a more structurally convenient reply message. convertMsg :: FilePath -> SourceInfo -> CompileMessage
src/library/FP/Server/Config.hs view
@@ -1,9 +1,13 @@+{-# LANGUAGE OverloadedStrings #-}+ -- | Server configuration. module FP.Server.Config where +import Data.Text (Text)+ -- | Default url to accept commands on.-defaultUrl :: String+defaultUrl :: Text defaultUrl = "https://www.fpcomplete.com/" -- | Default port to accept commands on.
src/library/FP/Server/Spans.hs view
@@ -27,8 +27,8 @@ T.pack (show fromCol) toSpanType :: TypeInfo -> SpanType-toSpanType (TypeInfo (SourceSpan _ sl sc el ec) srcstr typs) =- SpanType sl sc el ec srcstr typs+toSpanType (TypeInfo (SourceSpan _ sl sc el ec) srcstr typ) =+ SpanType sl sc el ec srcstr typ makeEitherLoc :: FilePath -> EitherSpan -> Maybe Loc makeEitherLoc _ TextSpan{} = Nothing
src/library/FP/Server/Types.hs view
@@ -15,7 +15,7 @@ import FP.Server.Config import Control.Concurrent (MVar)-import Control.Monad.Logger+import Control.Monad.Logger (LoggingT) import Control.Monad.Reader import Data.Aeson import Data.Default@@ -52,8 +52,8 @@ -- | Configuration for server. data Config = Config- { configToken :: !String- , configUrl :: !String+ { configToken :: !Text+ , configUrl :: !Text , configPort :: !Integer , configAgent :: !Text , configDebug :: !Bool@@ -121,7 +121,7 @@ -- | A type info thing. data SpanType = SpanType Int Int Int Int -- Position Text -- Source string- [Text] -- Types+ Text -- Types deriving (Generic,Show) instance ToJSON SpanType