telegraph 1.0.0 → 1.1.0
raw patch · 4 files changed
+46/−33 lines, 4 files
Files
- CHANGELOG.md +6/−0
- src/Control/Effect/Telegraph.hs +10/−26
- src/Web/Telegraph/API.hs +29/−6
- telegraph.cabal +1/−1
CHANGELOG.md view
@@ -7,3 +7,9 @@ ## 1.0.0 - Rewrite using in-other-words++## 1.1.0++- Performance optimizations+- Remove `errorToIO'` and `errorToErrorIO'`+- Rename `errorToIOThrowing` to `errorToIOAsExc` and `errorToErrorIOThrowing` to `errorToErrorIOAsExc`
src/Control/Effect/Telegraph.hs view
@@ -50,6 +50,7 @@ TelegraphC m a -> m a telegraph = interpretViaHandler+{-# INLINE telegraph #-} data HttpH @@ -63,51 +64,34 @@ type HttpC = InterpretC HttpH Http +-- | Interpret an @Http@ effect http :: Effs '[Embed IO, Reader Manager] m => HttpC m a -> m a http = interpretViaHandler--errorToErrorIO' ::- (Exception e, Effs '[ErrorIO, Embed IO] m) =>- InterpretErrorC e m a ->- m (Either e a)-errorToErrorIO' main = fmap Right main' `catchIO` (pure . Left)- where- main' =- interpret (\(Throw e) -> throwIO e) $- interpret (\(Catch m h) -> m `catchIO` h) $- runComposition main+{-# INLINE http #-} -errorToErrorIOThrowing ::+errorToErrorIOAsExc :: (Exception e, Effs '[ErrorIO, Embed IO] m) => InterpretErrorC e m a -> m a-errorToErrorIOThrowing main =+errorToErrorIOAsExc main = interpret (\(Throw e) -> throwIO e) $ interpret (\(Catch m h) -> m `catchIO` h) $ runComposition main--errorToIO' ::- (Exception e, Eff (Embed IO) m, MonadCatch m) =>- ErrorToIOC e m a ->- m (Either e a)-errorToIO' m =- errorIOToIO $- errorToErrorIO' $- introUnderMany $- runComposition m+{-# INLINE errorToErrorIOAsExc #-} -errorToIOThrowing ::+errorToIOAsExc :: (Exception e, Eff (Embed IO) m, MonadCatch m) => ErrorToIOC e m a -> m a-errorToIOThrowing m =+errorToIOAsExc m = errorIOToIO $- errorToErrorIOThrowing $+ errorToErrorIOAsExc $ introUnderMany $ runComposition m+{-# INLINE errorToIOAsExc #-} takeTS :: Eff Telegraph m => m TS takeTS = send TakeTS
src/Web/Telegraph/API.hs view
@@ -7,7 +7,9 @@ {-# LANGUAGE UndecidableInstances #-} -- | The telegraph API.--- Every function that runs in 'MonadTelegraph' might throw a 'TelegraphError'.+-- Note that the @'Error' 'HttpException'@ effect should be interpreted using+-- either 'errorToIOAsExc' or 'errorToErrorIOAsExc' or otherwise it won't get+-- caught. module Web.Telegraph.API ( -- ** Types AccountInfo (..),@@ -24,10 +26,8 @@ runTelegraph', -- *** Error Interpreters- errorToIO',- errorToErrorIO',- errorToIOThrowing,- errorToErrorIOThrowing,+ errorToIOAsExc,+ errorToErrorIOAsExc, -- ** Account related APIs editAccountInfo,@@ -96,6 +96,7 @@ -- | Use this method to create a new Telegraph account createAccount :: Eff Http' m => AccountInfo -> m (Result Account) createAccount !a = postAeson "https://api.telegra.ph/createAccount" a+{-# INLINEABLE createAccount #-} -- | Use this method to update information about this Telegraph account editAccountInfo :: (Effs '[Telegraph', Bracket, Throw TelegraphError] m) => AccountInfo -> m ()@@ -119,12 +120,14 @@ Result Account {} -> do let t' = TS {..} putTS t'+{-# INLINEABLE editAccountInfo #-} -- | Use this method to get information about this Telegraph account getAccountInfo :: Effs '[Telegraph', Throw TelegraphError] m => m Account getAccountInfo = do TS {accessToken} <- readTS processResult =<< getAccountInfo' accessToken+{-# INLINEABLE getAccountInfo #-} getAccountInfo' :: Eff Http' m => Text -> m (Result Account) getAccountInfo' accessToken = postAeson "https://api.telegra.ph/getAccountInfo" o@@ -136,6 +139,7 @@ [ "access_token" .= accessToken, "fields" .= fields ]+{-# INLINEABLE getAccountInfo' #-} -- | Use this method to revoke access_token and generate a new one revokeAccessToken :: (Effs '[Telegraph', Bracket, Error TelegraphError] m) => m Account@@ -149,6 +153,7 @@ let t' = TS {accessToken = fromJust accessToken', ..} putTS t' pure a+{-# INLINEABLE revokeAccessToken #-} data CreatePage = CreatePage { accessToken :: Text,@@ -180,6 +185,7 @@ "content" .= content ] processResult =<< postAeson "https://api.telegra.ph/createPage" o+{-# INLINEABLE createPage #-} -- | Use this method to edit an existing Telegraph page editPage ::@@ -203,6 +209,7 @@ "content" .= content ] processResult =<< postAeson "https://api.telegra.ph/editPage" o+{-# INLINEABLE editPage #-} -- | Use this method to get a Telegraph page getPage :: Eff Http' m => Text -> m (Result Page)@@ -213,6 +220,7 @@ "return_content" .= True ] postAeson "https://api.telegra.ph/getPage" o+{-# INLINEABLE getPage #-} -- | Use this method to get a list of pages belonging to this Telegraph account getPageList ::@@ -231,12 +239,14 @@ "limit" .= limit ] processResult =<< postAeson "https://api.telegra.ph/getPageList" o+{-# INLINEABLE getPageList #-} -- | Use this method to get the total number of views for a Telegraph article getTotalViews :: Eff Http' m => Text -> m (Result PageViews) getTotalViews path = postAeson "https://api.telegra.ph/getViews" o where o = object ["path" .= path]+{-# INLINEABLE getTotalViews #-} -------------------------------------------------- -- Upload API@@ -250,6 +260,7 @@ case eitherDecode (responseBody resp) of Left e -> error ("impossible: json decode failure: " ++ e) Right r -> pure r+{-# INLINEABLE uploadParts #-} -- | Upload a image from a filepath to Telegraph uploadImageFromFile :: (Effs '[Telegraph', Bracket, Embed IO] m) => FilePath -> m UploadResult@@ -259,6 +270,7 @@ let body = requestBodySourceChunked src part = partFileRequestBody "file" fp body lift $ uploadParts [part]+{-# INLINEABLE uploadImageFromFile #-} -- | Upload a list of images to Telegraph. The resulting list of images will be in the same order uploadImageFromFiles :: (Effs '[Telegraph', Bracket, Embed IO] m) => [FilePath] -> m UploadResult@@ -268,9 +280,10 @@ let bodies = map requestBodySourceChunked srcs parts = zipWith (\fp -> partFileRequestBody (pack fp) fp) fps bodies lift $ uploadParts parts+{-# INLINEABLE uploadImageFromFiles #-} data ImgStream = ImgStream- { -- | an image stream needs a filename+ { -- | filename name :: Text, stream :: forall i n. MonadIO n => ConduitT i ByteString n () }@@ -283,10 +296,12 @@ -- | Upload a image stream to Telegraph uploadImageStreaming :: Eff Telegraph' m => ImgStream -> m UploadResult uploadImageStreaming imgs = uploadParts [imgStream2Part imgs]+{-# INLINEABLE uploadImageStreaming #-} -- | Upload a list of image streams to Telegraph. The resulting list of images uploadImagesStreaming :: Eff Telegraph' m => [ImgStream] -> m UploadResult uploadImagesStreaming imgss = uploadParts $ map imgStream2Part imgss+{-# INLINEABLE uploadImagesStreaming #-} -------------------------------------------------- -- Utils@@ -305,6 +320,7 @@ case eitherDecode (responseBody resp) of Left e -> error ("impossible: json decode failure: " ++ e) Right r -> pure r+{-# INLINE postAeson #-} type TelegraphToIOC = CompositionC@@ -313,6 +329,7 @@ HttpC ] +-- | Interpret a 'Http' effect together with a 'Telegraph' effect with a supplied access token runTelegraph :: (Effs '[Embed IO, Reader Manager, Error HttpException, Throw TelegraphError] m, Threaders '[ReaderThreads] m p) => Text ->@@ -323,7 +340,10 @@ Account {shortName, authorName, authorUrl} <- processResult =<< getAccountInfo' accessToken ref <- embed $ newMVar TS {..} runReader ref $ telegraph $ runComposition m+{-# INLINE runTelegraph #-} +-- | Interpret a 'Http' effect together with a 'Telegraph' effect with account info+-- that will be used to create a new account runTelegraph' :: (Effs '[Embed IO, Reader Manager, Error HttpException, Throw TelegraphError] m, Threaders '[ReaderThreads] m p) => AccountInfo ->@@ -334,10 +354,12 @@ Account {shortName, authorName, authorUrl, accessToken = accessToken'} <- processResult =<< createAccount acc ref <- embed $ newMVar TS {accessToken = fromJust accessToken', ..} runReader ref $ telegraph $ runComposition m+{-# INLINE runTelegraph' #-} processResult :: Eff (Throw TelegraphError) m => Result a -> m a processResult (Error e) = throw $ APICallFailure e processResult (Result r) = pure r+{-# INLINE processResult #-} evalContT :: Applicative m => ContT r m r -> m r evalContT m = runContT m pure@@ -349,3 +371,4 @@ (embed $ openBinaryFile fp ReadMode) (embed . hClose) (k . sourceHandle)+{-# INLINE withSourceFile #-}
telegraph.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.0 name: telegraph-version: 1.0.0+version: 1.1.0 synopsis: Binding to the telegraph API description: Binding to the telegraph API category: Web