deepl (empty) → 0.1.0.0

raw patch · 8 files changed

+266/−0 lines, 8 filesdep +aesondep +basedep +bytestringsetup-changed

Dependencies added: aeson, base, bytestring, cmdargs, deepl, foldl, lens, lens-aeson, protolude, resourcet, streaming, streaming-bytestring, wreq

Files

ChangeLog.md +3/−0
LICENSE +30/−0
README.md +15/−0
Setup.hs +2/−0
app/Main.hs +39/−0
deepl.cabal +66/−0
src/Config.hs +16/−0
src/DeepL.hs +95/−0

+ ChangeLog.md view

@@ -0,0 +1,3 @@+# Changelog for deepl++## Unreleased changes

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright Global Access (c) 2021++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Author name here nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

+ README.md view

@@ -0,0 +1,15 @@+# deepl command line translator +++## build++if you need stack:+> curl -sSL https://get.haskellstack.org/ | sh ++install with +> stack install ++## run ++> deepl --help+

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ app/Main.hs view

@@ -0,0 +1,39 @@+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-cse #-}++module Main where++import Config+import DeepL (translateFile)+import Protolude+import System.Console.CmdArgs+  ( Data+  , Default (def)+  , cmdArgs+  , details+  , help+  , summary+  , typ+  , (&=)+  )+import Prelude hiding (print)++config :: Config+config =+  Config+    { token = "" &= help "deepL token" &= typ "abc123abc123"+    , input = def &= help "file to translate from" &= typ "input.txt"+    , output = def &= help "file to translate to" &= typ "output.txt"+    , lang = "" &= help "language to translate to" &= typ "EN"+    }+    &= help "deepl translator"+    &= summary "deepl-0.0.1, (C) Global Access 2021"+    &= details+      [ "deepl translates your files using deepl service"+      , ""+      , "You need a deepl token, get options with"+      , "  deepl --help"+      ]++main :: IO ()+main = cmdArgs config >>= translateFile

+ deepl.cabal view

@@ -0,0 +1,66 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.34.4.+--+-- see: https://github.com/sol/hpack++name:           deepl+version:        0.1.0.0+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+author:         Paolo Veronelli+maintainer:     paolo.veronelli@gmail.com+copyright:      2021 Global Access+license:        BSD3+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    README.md+    ChangeLog.md++library+  exposed-modules:+      Config+      DeepL+  other-modules:+      Paths_deepl+  hs-source-dirs:+      src+  build-depends:+      aeson+    , base >=4.7 && <5+    , bytestring+    , cmdargs+    , foldl+    , lens+    , lens-aeson+    , protolude+    , resourcet+    , streaming+    , streaming-bytestring+    , wreq+  default-language: Haskell2010++executable deepl+  main-is: Main.hs+  other-modules:+      Paths_deepl+  hs-source-dirs:+      app+  ghc-options: -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      aeson+    , base >=4.7 && <5+    , bytestring+    , cmdargs+    , deepl+    , foldl+    , lens+    , lens-aeson+    , protolude+    , resourcet+    , streaming+    , streaming-bytestring+    , wreq+  default-language: Haskell2010

+ src/Config.hs view

@@ -0,0 +1,16 @@+{-# 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)

+ src/DeepL.hs view

@@ -0,0 +1,95 @@+{-# 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)