telegraph 1.1.1 → 1.2.0
raw patch · 7 files changed
+67/−63 lines, 7 filesdep −deriving-aesondep ~in-other-wordsdep ~optics-th
Dependencies removed: deriving-aeson
Dependency ranges changed: in-other-words, optics-th
Files
- CHANGELOG.md +5/−0
- src/Control/Effect/Telegraph.hs +5/−24
- src/Web/Telegraph/API.hs +20/−17
- src/Web/Telegraph/Types.hs +22/−18
- src/Web/Telegraph/Utils.hs +9/−0
- telegraph.cabal +5/−4
- test/Spec.hs +1/−0
CHANGELOG.md view
@@ -19,3 +19,8 @@ - Performance optimizations - Fix tests - Generate labeled optics++## 1.2.0++- Bump dependencies+- Performance optimizations
src/Control/Effect/Telegraph.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE UndecidableInstances #-} module Control.Effect.Telegraph where@@ -7,15 +8,14 @@ import Control.Concurrent import Control.Effect import Control.Effect.Error-import Control.Effect.ErrorIO import Control.Effect.Reader import Data.ByteString (ByteString) import qualified Data.ByteString.Lazy as LBS import Data.Text (Text)-import GHC.Generics import Network.HTTP.Client import qualified Network.HTTP.Client as C import Network.HTTP.Client.MultipartFormData+import Optics.TH data Http :: Effect where HttpLbs :: Request -> Http m (Response LBS.ByteString)@@ -72,27 +72,6 @@ http = interpretViaHandler {-# INLINE http #-} -errorToErrorIOAsExc ::- (Exception e, Effs '[ErrorIO, Embed IO] m) =>- InterpretErrorC e m a ->- m a-errorToErrorIOAsExc main =- interpret (\(Throw e) -> throwIO e) $- interpret (\(Catch m h) -> m `catchIO` h) $- runComposition main-{-# INLINE errorToErrorIOAsExc #-}--errorToIOAsExc ::- (Exception e, Eff (Embed IO) m, MonadCatch m) =>- ErrorToIOC e m a ->- m a-errorToIOAsExc m =- errorIOToIO $- errorToErrorIOAsExc $- introUnderMany $- runComposition m-{-# INLINE errorToIOAsExc #-}- takeTS :: Eff Telegraph m => m TS takeTS = send TakeTS {-# INLINE takeTS #-}@@ -120,4 +99,6 @@ authorName :: Text, authorUrl :: Text }- deriving (Show, Eq, Generic)+ deriving (Show, Eq)++makeFieldLabelsWith noPrefixFieldLabels ''TS
src/Web/Telegraph/API.hs view
@@ -4,6 +4,8 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RankNTypes #-}+{-# LANGUAGE StrictData #-}+{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE UndecidableInstances #-} -- | The telegraph API.@@ -25,10 +27,6 @@ runTelegraph, runTelegraph', - -- *** Error Interpreters- errorToIOAsExc,- errorToErrorIOAsExc,- -- ** Account related APIs editAccountInfo, getAccountInfo,@@ -73,25 +71,25 @@ import Control.Effect.Reader import Control.Effect.Telegraph import Control.Monad.Cont-import Data.Aeson (eitherDecode, encode, object, (.=))+import Data.Aeson (FromJSON, ToJSON, eitherDecode, encode, object, (.=))+import Data.Aeson.TH import Data.ByteString (ByteString) import Data.Maybe import Data.Text (Text, pack, unpack)-import Deriving.Aeson-import Deriving.Aeson.Stock import Network.HTTP.Client (HttpException, Manager, Request (..), RequestBody (..), Response (..), parseRequest_) import Network.HTTP.Client.Conduit (requestBodySourceChunked) import Network.HTTP.Client.MultipartFormData+import Optics.TH import System.IO import Web.Telegraph.Types hiding (error)+import Web.Telegraph.Utils data AccountInfo = AccountInfo- { shortName :: Text,- authorName :: Text,- authorUrl :: Text+ { shortName :: {-# UNPACK #-} Text,+ authorName :: {-# UNPACK #-} Text,+ authorUrl :: {-# UNPACK #-} Text }- deriving (Show, Eq, Generic)- deriving (FromJSON, ToJSON) via Snake AccountInfo+ deriving (Show, Eq) -- | Use this method to create a new Telegraph account createAccount :: Eff Http' m => AccountInfo -> m (Result Account)@@ -156,15 +154,14 @@ {-# INLINEABLE revokeAccessToken #-} data CreatePage = CreatePage- { accessToken :: Text,- title :: Text,+ { accessToken :: {-# UNPACK #-} Text,+ title :: {-# UNPACK #-} Text, authorName :: Maybe Text, authorUrl :: Maybe Text, content :: [Node], returnContent :: Bool }- deriving (Show, Eq, Generic)- deriving (FromJSON, ToJSON) via Snake CreatePage+ deriving (Show, Eq) -- | Use this method to create a new Telegraph page createPage ::@@ -284,7 +281,7 @@ data ImgStream = ImgStream { -- | filename- name :: Text,+ name :: {-# UNPACK #-} Text, stream :: forall i n. MonadIO n => ConduitT i ByteString n () } @@ -372,3 +369,9 @@ (embed . hClose) (k . sourceHandle) {-# INLINE withSourceFile #-}++deriveJSON snake ''AccountInfo+deriveJSON snake ''CreatePage+makeFieldLabelsWith noPrefixFieldLabels ''AccountInfo+makeFieldLabelsWith noPrefixFieldLabels ''CreatePage+makeFieldLabelsWith noPrefixFieldLabels ''ImgStream
src/Web/Telegraph/Types.hs view
@@ -11,12 +11,13 @@ import Control.Exception import Data.Aeson hiding (Result (..))+import Data.Aeson.TH import Data.Maybe import Data.Text (Text, unpack)-import Deriving.Aeson-import Deriving.Aeson.Stock+import GHC.Generics import Generic.Data.Surgery import Optics.TH+import Web.Telegraph.Utils -- | A Telegraph account data Account = Account@@ -39,8 +40,7 @@ -- | Number of pages belonging to the Telegraph account pageCount :: Maybe Int }- deriving (Show, Eq, Generic)- deriving (FromJSON, ToJSON) via CustomJSON '[FieldLabelModifier CamelToSnake, OmitNothingFields] Account+ deriving (Show, Eq) -- | A list of Telegraph articles belonging to an account --@@ -51,8 +51,7 @@ -- | Requested pages of the target Telegraph account pages :: [Page] }- deriving (Show, Eq, Generic)- deriving (FromJSON, ToJSON) via Snake PageList+ deriving (Show, Eq) -- | A page on Telegraph data Page = Page@@ -79,20 +78,17 @@ -- | True, if the target Telegraph account can edit the page canEdit :: Maybe Bool }- deriving (Show, Eq, Generic)- deriving (FromJSON, ToJSON) via CustomJSON '[FieldLabelModifier CamelToSnake, OmitNothingFields] Page+ deriving (Show, Eq) -- | The number of page views for a Telegraph article newtype PageViews = PageViews {views :: Int}- deriving (Show, Eq, Generic)- deriving (FromJSON, ToJSON) via Vanilla PageViews+ deriving (Show, Eq) -- | A DOM Node data Node = Content {-# UNPACK #-} Text | Element {-# UNPACK #-} NodeElement- deriving (Show, Eq, Generic)- deriving (FromJSON, ToJSON) via CustomJSON '[SumUntaggedValue] Node+ deriving (Show, Eq) -- | A DOM elemen node data NodeElement = NodeElement@@ -111,7 +107,6 @@ children :: [Node] } deriving (Show, Eq, Generic)- deriving (ToJSON) via Vanilla NodeElement instance FromJSON NodeElement where parseJSON =@@ -127,7 +122,7 @@ data Result a = Error {-# UNPACK #-} Text | Result a- deriving (Show, Eq, Generic)+ deriving (Show, Eq) instance FromJSON a => FromJSON (Result a) where parseJSON = withObject "telegra.ph api call result" $ \o -> do@@ -141,15 +136,13 @@ { -- | The path to the image src :: Text }- deriving (Show, Eq, Generic)- deriving (FromJSON, ToJSON) via Vanilla Image+ deriving (Show, Eq) -- | The result of an image upload data UploadResult = UploadError {error :: {-# UNPACK #-} Text} | Sources [Image]- deriving (Show, Eq, Generic)- deriving (FromJSON, ToJSON) via CustomJSON '[SumUntaggedValue] UploadResult+ deriving (Show, Eq) newtype TelegraphError = -- | An api call has failed, we cannot distinguish between minor errors (such as illformed author urls)@@ -161,6 +154,17 @@ instance Show TelegraphError where show (APICallFailure e) = "API call failed with error: " ++ unpack e +--------------------------------------------------+-- Utilities++deriveJSON snake ''Account+deriveJSON snake ''PageList+deriveJSON snake ''Page+deriveJSON snake ''PageViews+deriveJSON sumUntagged ''Node+deriveToJSON snake ''NodeElement+deriveJSON snake ''Image+deriveJSON sumUntagged ''UploadResult makeFieldLabelsWith noPrefixFieldLabels ''Account makeFieldLabelsWith noPrefixFieldLabels ''PageList makeFieldLabelsWith noPrefixFieldLabels ''Page
+ src/Web/Telegraph/Utils.hs view
@@ -0,0 +1,9 @@+module Web.Telegraph.Utils where++import Data.Aeson++sumUntagged :: Options+sumUntagged = defaultOptions {sumEncoding = UntaggedValue}++snake :: Options+snake = defaultOptions {fieldLabelModifier = camelTo2 '_', omitNothingFields = True}
telegraph.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.0 name: telegraph-version: 1.1.1+version: 1.2.0 synopsis: Binding to the telegraph API description: Binding to the telegraph API category: Web@@ -20,7 +20,7 @@ build-depends: , base >=4.10 && <5 , http-client >=0.6.4 && <=0.8- , in-other-words ^>=0.1.0+ , in-other-words ^>=0.2.0 default-language: Haskell2010 default-extensions:@@ -59,7 +59,6 @@ , aeson >=1.4.7 && <1.6 , bytestring >=0.10.12 && <0.12 , conduit ^>=1.3.4- , deriving-aeson ^>=0.2.6 , generic-data-surgery ^>=0.3.0 , http-conduit ^>=2.3.7 , mtl ^>=2.2.2@@ -70,7 +69,9 @@ Web.Telegraph.API Web.Telegraph.Types - other-modules: Control.Effect.Telegraph+ other-modules:+ Control.Effect.Telegraph+ Web.Telegraph.Utils hs-source-dirs: src test-suite telegraph-test
test/Spec.hs view
@@ -3,6 +3,7 @@ module Main where import Control.Effect+import Control.Effect.Error import Control.Effect.Reader import Network.HTTP.Client (HttpException) import Network.HTTP.Client.TLS