deepl 0.1.0.0 → 0.1.0.1

raw patch · 6 files changed

+116/−116 lines, 6 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• app/Main.hs +2/−2
• deepl.cabal +3/−3
• src/Config.hs +0/−16
• src/DeepL.hs +0/−95
• src/DeepL/Config.hs +16/−0
• src/DeepL/Translate.hs +95/−0

@@ -3,8 +3,8 @@  module Main where -import Config-import DeepL (translateFile)+import DeepL.Config+import DeepL.Translate (translateFile) import Protolude import System.Console.CmdArgs   ( Data

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           deepl-version:        0.1.0.0+version:        0.1.0.1 synopsis:       Call DeepL to translate you files description:    Please see the README on GitHub at <https://gitlab.com/global-access-public/deepl/-/blob/master/README.md> category:       Web, Language@@ -21,8 +21,8 @@  library   exposed-modules:-      Config-      DeepL+      DeepL.Config+      DeepL.Translate   other-modules:       Paths_deepl   hs-source-dirs:

@@ -1,16 +0,0 @@-{-# LANGUAGE DeriveDataTypeable #-}--module Config where--import Data.Data (Data)-import Protolude (Text, Typeable)--type Token = Text--data Config = Config-  { token :: Token-  , input :: FilePath-  , output :: FilePath-  , lang :: Text-  }-  deriving (Show, Data, Typeable)

@@ -1,95 +0,0 @@-{-# LANGUAGE BlockArguments #-}-{-# LANGUAGE NumericUnderscores #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE NoImplicitPrelude #-}-{-# OPTIONS_GHC -fno-cse #-}--module DeepL where--import Config (Config (..))-import qualified Control.Foldl as L-import Control.Lens (lmap, (^?), _head)-import Control.Monad.Trans.Resource (register, runResourceT)-import Data.Aeson.Lens-  ( AsPrimitive (_String)-  , AsValue (_Array)-  , key-  )-import Data.ByteString (ByteString)-import qualified Data.ByteString.Char8 as B-import Network.Wreq (FormParam ((:=)), post, responseBody)-import Protolude-import Streaming (Of (..), Stream, effect, inspect, wrap)-import qualified Streaming.ByteString.Char8 as SB-import qualified Streaming.Prelude as S-import System.IO (hClose, openBinaryFile)--defaultDeepL :: Config -> Text -> IO Text-defaultDeepL config x = fromMaybe x <$> deepL config x--deepL :: Config -> Text -> IO (Maybe Text)-deepL Config {..} x = do-  r <--    post-      "https://api.deepl.com/v2/translate"-      [ "auth_key" := token-      , "text" := x-      , "target_lang" := lang-      ]-  pure $-    r-      ^? responseBody-        . key "translations"-        . _Array-        . _head-        . key "text"-        . _String--limit :: Int-limit = 30_000--translateFile :: Config -> IO ()-translateFile config@Config {..} = runResourceT $ do-  handleIn <- case input of-    "" -> pure stdin-    filePath -> do-      h <- liftIO $ openBinaryFile filePath ReadMode-      register $ hClose h-      pure h-  handleOut <- case output of-    "" -> pure stdout-    filePath -> do-      h <- liftIO $ openBinaryFile filePath WriteMode-      register $ hClose h-      pure h-  SB.toHandle handleOut-    . SB.unlines-    . S.maps (\(x :> r) -> r <$ SB.fromStrict (B.init x))-    . S.mapped do-      \s -> do-        rs :> rest <- S.toList s-        z <- liftIO $ defaultDeepL config $ decodeUtf8 . B.unlines . fmap fst $ rs-        pure $ encodeUtf8 z :> rest-    . breaker-    . S.map-      do \v -> (v, B.length v)-    . S.mapped SB.toStrict-    . SB.lines-    $ SB.fromHandle handleIn--breaker-  :: Monad m-  => Stream (Of (ByteString, Int)) m r-  -> Stream (Stream (Of (ByteString, Int)) m) m r-breaker s = effect $ do-  x <- inspect s-  pure $ case x of-    Left r -> pure r-    Right q -> wrap $ fmap breaker $ step $ wrap q--step-  :: Monad m-  => Stream (Of (ByteString, Int)) m r-  -> Stream (Of (ByteString, Int)) m (Stream (Of (ByteString, Int)) m r)-step = L.purely S.breakWhen (lmap snd L.sum) (> limit)

@@ -0,0 +1,16 @@+{-# LANGUAGE DeriveDataTypeable #-}++module DeepL.Config where++import Data.Data (Data)+import Protolude (Text, Typeable)++type Token = Text++data Config = Config+  { token :: Token+  , input :: FilePath+  , output :: FilePath+  , lang :: Text+  }+  deriving (Show, Data, Typeable)

@@ -0,0 +1,95 @@+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE NumericUnderscores #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# OPTIONS_GHC -fno-cse #-}++module DeepL.Translate where++import DeepL.Config (Config (..))+import qualified Control.Foldl as L+import Control.Lens (lmap, (^?), _head)+import Control.Monad.Trans.Resource (register, runResourceT)+import Data.Aeson.Lens+  ( AsPrimitive (_String)+  , AsValue (_Array)+  , key+  )+import Data.ByteString (ByteString)+import qualified Data.ByteString.Char8 as B+import Network.Wreq (FormParam ((:=)), post, responseBody)+import Protolude+import Streaming (Of (..), Stream, effect, inspect, wrap)+import qualified Streaming.ByteString.Char8 as SB+import qualified Streaming.Prelude as S+import System.IO (hClose, openBinaryFile)++defaultDeepL :: Config -> Text -> IO Text+defaultDeepL config x = fromMaybe x <$> deepL config x++deepL :: Config -> Text -> IO (Maybe Text)+deepL Config {..} x = do+  r <-+    post+      "https://api.deepl.com/v2/translate"+      [ "auth_key" := token+      , "text" := x+      , "target_lang" := lang+      ]+  pure $+    r+      ^? responseBody+        . key "translations"+        . _Array+        . _head+        . key "text"+        . _String++limit :: Int+limit = 30_000++translateFile :: Config -> IO ()+translateFile config@Config {..} = runResourceT $ do+  handleIn <- case input of+    "" -> pure stdin+    filePath -> do+      h <- liftIO $ openBinaryFile filePath ReadMode+      register $ hClose h+      pure h+  handleOut <- case output of+    "" -> pure stdout+    filePath -> do+      h <- liftIO $ openBinaryFile filePath WriteMode+      register $ hClose h+      pure h+  SB.toHandle handleOut+    . SB.unlines+    . S.maps (\(x :> r) -> r <$ SB.fromStrict (B.init x))+    . S.mapped do+      \s -> do+        rs :> rest <- S.toList s+        z <- liftIO $ defaultDeepL config $ decodeUtf8 . B.unlines . fmap fst $ rs+        pure $ encodeUtf8 z :> rest+    . breaker+    . S.map+      do \v -> (v, B.length v)+    . S.mapped SB.toStrict+    . SB.lines+    $ SB.fromHandle handleIn++breaker+  :: Monad m+  => Stream (Of (ByteString, Int)) m r+  -> Stream (Stream (Of (ByteString, Int)) m) m r+breaker s = effect $ do+  x <- inspect s+  pure $ case x of+    Left r -> pure r+    Right q -> wrap $ fmap breaker $ step $ wrap q++step+  :: Monad m+  => Stream (Of (ByteString, Int)) m r+  -> Stream (Of (ByteString, Int)) m (Stream (Of (ByteString, Int)) m r)+step = L.purely S.breakWhen (lmap snd L.sum) (> limit)