fpco-api 1.2.0.2 → 1.2.0.3
raw patch · 5 files changed
+186/−7 lines, 5 filesdep −yesod-fay
Dependencies removed: yesod-fay
Files
- fpco-api.cabal +3/−2
- src/library/FP/API/Common.hs +3/−3
- src/library/FP/API/Convert.hs +104/−0
- src/library/FP/Server.hs +2/−2
- src/library/Language/Fay/Yesod.hs +74/−0
fpco-api.cabal view
@@ -1,5 +1,5 @@ name: fpco-api-version: 1.2.0.2+version: 1.2.0.3 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@@ -25,6 +25,7 @@ exposed-modules: FP.API , FP.API.Common+ , FP.API.Convert , FP.API.ModuleName , FP.API.Runner , FP.API.Signal@@ -36,6 +37,7 @@ other-modules: FFI , FP.API.Dispatch+ , Language.Fay.Yesod build-depends: base >=4 && < 5 , aeson >= 0.6@@ -83,7 +85,6 @@ , unordered-containers >= 0.2 , vector >= 0.10 , yesod-core >= 1.2- , yesod-fay >= 0.4 executable fpco-api if flag(jenkins-build)
src/library/FP/API/Common.hs view
@@ -39,7 +39,7 @@ import FP.API as API import FP.API.Dispatch import FP.API.Signal-import Fay.Convert+import FP.API.Convert import Language.Fay.Yesod (Returns(..)) import Prelude hiding (FilePath)@@ -258,7 +258,7 @@ Nothing -> clientFail $ "Call timed out: " <> T.pack shownCmd Just (Left err) -> return $ Left err Just (Right val) ->- case readFromFay' val of+ case decodeFpco val of Left err -> clientFail $ "Failed to parse response to " <> T.pack shownCmd <> ": " <> T.pack err Right (Success x) -> do didRestart <- liftIO $ atomically $ updateSessionCompileId ciCompileId ciSessionId x@@ -338,7 +338,7 @@ "Could not parse JSON of response to " <> shownCmd <> ". Here's the response: " <> decodeUtf8 (BS.concat (LBS.toChunks body)) Just json ->- case readFromFay' json of+ case decodeFpco json of Left err -> clientFail $ "Error interpreting response from " <> shownCmd <> ". Here's the error: " <> T.pack err
+ src/library/FP/API/Convert.hs view
@@ -0,0 +1,104 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- | Custom fpco conversion of Haskell values to a JSON Fay value.++module FP.API.Convert+ (encodeFpco+ ,decodeFpco+ ,validFileName+ ,validateFilePath)+ where++import Control.Monad+import Data.Aeson+import Data.Aeson.Types (parseEither)+import Data.ByteString (ByteString)+import qualified Data.ByteString.Char8 as BS+import Data.Data+import Data.Generics.Aliases+import qualified Data.Text as Text+import Fay.Convert (encodeFay, decodeFay)+import qualified FP.API as API+import FP.API.ModuleName+import Prelude++encodeFpco :: GenericQ Value+encodeFpco = encodeFay $ \f -> (f+ `extQ` (int :: Integer -> Value))+ where+ int = Number . fromIntegral++{-+$ \f -> f+ `extQ` bytestring+ `extQ` int64+ where+ obj con = Object . Map.fromList . (("instance", String con):)+ wrapper con field val = obj con [(field, val)]+ bytestring = wrapper "ByteString" "slot1" . String . decodeUtf8 . B64.encode+ int64 :: Int64 -> Value+ int64 = wrapper "Int64" "slot1" . String . Text.pack . show+-}++decodeFpco :: Data a => Value -> Either String a+decodeFpco = decodeFay $ \value r -> r+ `extR` parseInteger value+ `extR` (validateEncFileName =<< normalDecode value)+ `extR` (either (Left . Text.unpack) Right . checkModuleName =<< normalDecode value)++normalDecode :: Data a => Value -> Either String a+normalDecode = decodeFay (\_ r' -> r')++{-+$ \value r -> r+ `extR` bytestring value+ `extR` int64 value+ where+ wrapper con field (Object mp)+ | Map.lookup "instance" mp == Just (String con)+ , Just val <- Map.lookup field mp+ = Right val+ wrapper con field val = Left $+ "Couldn't find expected " +++ Text.unpack con ++ " constructor with " +++ Text.unpack field ++ " field. Instead, got\n" +++ show val+ bytestring = B64.decode <=< fmap encodeUtf8 . expectText <=< wrapper "ByteString" "slot1"+ int64 :: Value -> Either String Int64+ int64 = expectRead <=< wrapper "Int64" "slot1"++expectText :: Value -> Either String Text+expectText (String txt) = Right txt+expectText val = Left $ "Expected string, but got " ++ show val++expectRead :: forall a. (Read a, Typeable a) => Value -> Either String a+expectRead val = maybe (Left err) Right . readMay . Text.unpack =<< expectText val+ where+ err = "Couldn't parse " ++ show (typeOf (undefined :: a)) ++ ", got: " ++ show val+-}++validateEncFileName :: API.EncFileName -> Either String API.EncFileName+validateEncFileName+ = fmap API.encFileNameFromByteString+ . validateFilePath+ . API.unFileName+ . API.unEncFileName++-- | Cannonicalizes and validates filepaths. See #1643.+validateFilePath :: ByteString -> Either String ByteString+validateFilePath path =+ case filter (not . BS.null) $ BS.splitWith (`elem` ['\\', '/']) $ BS.filter (/= '\NUL') path of+ [] -> Left "Invalid filepath: Empty"+ components -> Right $ BS.intercalate "/" components++validFileName :: ByteString -> Either String API.FileName+validFileName = fmap API.FileName . validateFilePath++-- |++-- Utilities copied from Fay.Convert++-- | Parse an int.+parseInteger :: Value -> Either String Integer+parseInteger = parseEither parseJSON
src/library/FP/Server.hs view
@@ -16,6 +16,7 @@ import FP.API import FP.API.Common+import FP.API.Convert import FP.API.Signal import FP.Server.Spans import FP.Server.Types@@ -42,7 +43,6 @@ import Data.Text.Encoding (decodeUtf8, encodeUtf8, decodeUtf8With) import Data.Text.Encoding.Error (lenientDecode) import qualified Data.Text.IO as T-import Fay.Convert import Language.Fay.Yesod (Returns(..)) import Network import Network.HTTP.Conduit@@ -445,7 +445,7 @@ ,("authorization",encodeUtf8 ("token " <> ccToken))] , responseTimeout = Nothing , cookieJar = Just jar- , requestBody = RequestBodyLBS $ encode (showToFay cmd)+ , requestBody = RequestBodyLBS $ encode (encodeFpco cmd) , checkStatus = \_ _ _ -> Nothing } $(logDebug) ("=> " <> trunc (T.pack (show cmd)))
+ src/library/Language/Fay/Yesod.hs view
@@ -0,0 +1,74 @@+-- NOTE: This file is auto-generated.+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE CPP #-}+-- | Module to be shared between server and client.+--+-- This module must be valid for both GHC and Fay.+module Language.Fay.Yesod where++import Prelude+#ifdef FAY+import FFI+#else+import Fay.FFI+#endif+import Data.Data++#ifdef FAY++data Text = Text+ deriving (Show, Read, Eq, Typeable, Data)++fromString :: String -> Text+fromString = ffi "%1"++toString :: Text -> String+toString = ffi "%1"++#else++import qualified Data.Text as T++type Text = T.Text++fromString :: String -> Text+fromString = T.pack++toString :: Text -> String+toString = T.unpack++#endif++-- | A proxy type for specifying what type a command should return. The final+-- field for each data constructor in a command datatype should be @Returns@.+data Returns a = Returns+ deriving (Eq, Show, Read, Data, Typeable)++-- | Call a command.+call :: (Returns a -> command)+ -> (a -> Fay ()) -- ^ Success Handler+ -> Fay ()+call f g = ajaxCommand (f Returns) g++-- ! Call a command, handling errors as well+callWithErrorHandling+ :: (Returns a -> command)+ -> (a -> Fay ()) -- ^ Success Handler+ -> (Fay ()) -- ^ Failure Handler+ -> Fay ()+callWithErrorHandling f g h = ajaxCommandWithErrorHandling (f Returns) g h++-- | Run the AJAX command.+ajaxCommand :: Automatic command+ -> (Automatic a -> Fay ()) -- ^ Success Handler+ -> Fay ()+ajaxCommand = ffi "jQuery['ajax']({ url: window['yesodFayCommandPath'], type: 'POST', data: { json: JSON.stringify(%1) }, dataType: 'json', success : %2})"++-- | Run the AJAX command, handling errors as well+ajaxCommandWithErrorHandling+ :: Automatic command+ -> (Automatic a -> Fay ()) -- ^ Success Handler+ -> (Fay ()) -- ^ Failure Handler+ -> Fay ()+ajaxCommandWithErrorHandling = ffi "jQuery['ajax']({ url: window['yesodFayCommandPath'], type: 'POST', data: { json: JSON.stringify(%1) }, dataType: 'json', success : %2, error: %3})"+