├── .circleci └── config.yml ├── .editorconfig ├── .github └── FUNDING.yml ├── .gitignore ├── .travis.yml ├── LICENSE ├── README.md ├── backend ├── .env.example ├── .env.test ├── .sosrc ├── .stylish-haskell.yaml ├── LICENSE ├── Setup.hs ├── app │ ├── fetch.hs │ └── main.hs ├── default.nix ├── deploy.sh ├── deploy │ └── nginx.conf ├── dist │ ├── favicon.ico │ ├── icon.png │ └── search.xml ├── package.yaml ├── scripts │ └── cabal2nix.sh ├── shell.nix ├── sql │ ├── latest.sql │ └── pg_dump.sh ├── src │ ├── Api │ │ ├── Search.hs │ │ ├── Subtitles.hs │ │ └── Talks.hs │ ├── Config.hs │ ├── Model.hs │ ├── Models │ │ ├── RedisKeys.hs │ │ ├── Talk.hs │ │ └── Types.hs │ ├── Server.hs │ ├── Static.hs │ ├── Types.hs │ ├── View │ │ ├── Bundle.hs │ │ ├── Error.hs │ │ ├── Home.hs │ │ ├── Layout.hs │ │ ├── Search.hs │ │ └── Talk.hs │ ├── Web │ │ ├── TED.hs │ │ └── TED │ │ │ ├── API.hs │ │ │ ├── Feed.hs │ │ │ ├── TalkPage.hs │ │ │ └── Types.hs │ └── docs.hs ├── stack.yaml ├── static │ ├── .gitkeep │ ├── img │ │ └── tweak.jpg │ ├── lrc │ │ └── .gitkeep │ ├── srt │ │ └── .gitkeep │ ├── txt │ │ └── .gitkeep │ └── vtt │ │ └── .gitkeep ├── ted2srt.nix ├── test │ ├── Main.hs │ ├── ReTed │ │ ├── ApiSpec.hs │ │ └── TestUtils.hs │ ├── Spec.hs │ ├── before.sh │ └── fixtures │ │ ├── data.sql │ │ ├── pg_dump.sh │ │ └── truncate.sql └── tests │ ├── ted.hs │ └── ted2srt.hs ├── frontend ├── .jshintrc ├── deploy.sh ├── package.json ├── packages.dhall ├── postcss.config.js ├── scripts │ └── build.sh ├── shell.nix ├── spago.dhall ├── src │ ├── Component │ │ ├── Footer.purs │ │ └── Header.purs │ ├── Core │ │ ├── Api.purs │ │ ├── Model.purs │ │ └── Prelude.purs │ ├── Home.purs │ ├── Home │ │ ├── App.purs │ │ └── main.css │ ├── HomePage.ts │ ├── Search.purs │ ├── Search │ │ ├── App.purs │ │ └── main.css │ ├── SearchPage.ts │ ├── Talk.purs │ ├── Talk │ │ ├── App.purs │ │ ├── Sidebar.purs │ │ ├── Types.purs │ │ ├── Util.purs │ │ └── main.css │ ├── TalkPage.ts │ ├── common.css │ ├── common.ts │ ├── index.html │ ├── purs.d.ts │ └── styles │ │ └── Link.css ├── tailwind.js ├── tsconfig.json ├── webpack.config.js └── yarn.lock └── nix ├── all.nix ├── nixpkgs.nix └── pkgs └── with-utf8.nix /.circleci/config.yml: -------------------------------------------------------------------------------- 1 | defaults: &defaults 2 | docker: 3 | - image: nonbili/nix:latest 4 | 5 | version: 2.1 6 | jobs: 7 | build: 8 | <<: *defaults 9 | 10 | steps: 11 | - checkout 12 | 13 | - restore_cache: 14 | keys: 15 | - frontend-{{ checksum "frontend/package.json" }}-{{ checksum "frontend/packages.dhall" }} 16 | 17 | - run: 18 | name: Build frontend 19 | working_directory: frontend 20 | command: | 21 | source ~/.profile 22 | yarn 23 | yarn build 24 | 25 | - save_cache: 26 | key: frontend-{{ checksum "frontend/package.json" }}-{{ checksum "frontend/packages.dhall" }} 27 | paths: 28 | - frontend/node_modules 29 | - frontend/output 30 | - frontend/dce-output 31 | - frontend/.spago 32 | - frontend/.psa-stash 33 | 34 | - run: 35 | name: Build backend 36 | working_directory: backend 37 | command: | 38 | source ~/.profile 39 | cachix use rnons 40 | nix-build -j2 --cores 2 41 | cp -r result/bin bin 42 | 43 | - persist_to_workspace: 44 | root: . 45 | paths: 46 | - backend/dist 47 | - backend/bin 48 | 49 | deploy: 50 | <<: *defaults 51 | 52 | steps: 53 | - checkout 54 | 55 | - attach_workspace: 56 | at: . 57 | 58 | - run: 59 | name: Deploy 60 | command: | 61 | rsync -q -e 'ssh -q -oStrictHostKeyChecking=no' -z -a --delete backend/dist/ ${DEPLOY_USER}@${DEPLOY_HOST}:/opt/ted2srt/dist 62 | rsync -q -e 'ssh -q -oStrictHostKeyChecking=no' -z -a --delete backend/bin/ ${DEPLOY_USER}@${DEPLOY_HOST}:/opt/ted2srt/bin 63 | 64 | workflows: 65 | build-and-deploy: 66 | jobs: 67 | - build 68 | - deploy: 69 | requires: 70 | - build 71 | filters: 72 | branches: 73 | only: 74 | - master 75 | -------------------------------------------------------------------------------- /.editorconfig: -------------------------------------------------------------------------------- 1 | # EditorConfig helps developers define and maintain consistent 2 | # coding styles between different editors and IDEs 3 | # editorconfig.org 4 | 5 | root = true 6 | 7 | 8 | [*] 9 | 10 | # change these settings to your own preference 11 | indent_style = space 12 | indent_size = 2 13 | 14 | # we recommend you to keep these unchanged 15 | end_of_line = lf 16 | charset = utf-8 17 | trim_trailing_whitespace = true 18 | insert_final_newline = true 19 | 20 | [*.md] 21 | trim_trailing_whitespace = false 22 | 23 | [{package,bower}.json] 24 | indent_style = space 25 | indent_size = 2 26 | 27 | [*.hs] 28 | indent_style = space 29 | indent_size = 4 30 | -------------------------------------------------------------------------------- /.github/FUNDING.yml: -------------------------------------------------------------------------------- 1 | github: [rnons] 2 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *.srt 2 | *.vtt 3 | *.txt 4 | *.lrc 5 | .env 6 | .stack-work/ 7 | ted2srt.cabal 8 | 9 | .DS_Store 10 | 11 | backend/dist/*.js 12 | backend/dist/*.map 13 | backend/dist/*.css 14 | backend/result 15 | 16 | static/tmp/ 17 | .psc-package 18 | .psc-ide-port 19 | .spago 20 | output/ 21 | dce-output/ 22 | node_modules 23 | bower_components 24 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | sudo: false 2 | 3 | # Caching so the next build will be fast too. 4 | cache: 5 | directories: 6 | - $HOME/.stack 7 | 8 | addons: 9 | postgresql: "9.4" 10 | apt: 11 | packages: 12 | - libgmp-dev 13 | 14 | before_install: 15 | # Download and unpack the stack executable 16 | - mkdir -p ~/.local/bin 17 | - export PATH=$HOME/.local/bin:$PATH 18 | - travis_retry curl -L https://www.stackage.org/stack/linux-x86_64 | tar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack' 19 | 20 | install: 21 | - stack --no-terminal setup 22 | 23 | script: 24 | - cd server 25 | - psql --version 26 | - stack --no-terminal --skip-ghc-check test 27 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | BSD 3-Clause License 2 | 3 | Copyright (c) 2018, Ping Chen 4 | All rights reserved. 5 | 6 | Redistribution and use in source and binary forms, with or without 7 | modification, are permitted provided that the following conditions are met: 8 | 9 | * Redistributions of source code must retain the above copyright notice, this 10 | list of conditions and the following disclaimer. 11 | 12 | * Redistributions in binary form must reproduce the above copyright notice, 13 | this list of conditions and the following disclaimer in the documentation 14 | and/or other materials provided with the distribution. 15 | 16 | * Neither the name of the copyright holder nor the names of its 17 | contributors may be used to endorse or promote products derived from 18 | this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 21 | AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 22 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 23 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 24 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 25 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 26 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 27 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 28 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 29 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 30 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # ted2srt 2 | 3 | [Donate](https://liberapay.com/rnons/) 4 | 5 | This is the source code of [ted2srt.org](https://ted2srt.org), a website to download bilingual subtitles of TED talks. The backend is written in Haskell, while the frontend is in PureScript. 6 | 7 | ## Set up development environment 8 | 9 | [Nix](https://nixos.org/nix/) is required for development. 10 | 11 | ### Frontend 12 | 13 | ``` 14 | cd frontend 15 | nix-shell 16 | spago build -w 17 | yarn 18 | yarn start 19 | ``` 20 | 21 | Run `yarn build` once, so that backend can start correctly. 22 | 23 | ### Backend 24 | 25 | ``` 26 | cd backend 27 | nix-shell 28 | stack build 29 | ``` 30 | 31 | While `stack` is running, you can setup the database. Postgres and Redis are needed, you can either use your system wide version or nix installed version. Following is how to use the nix version. 32 | 33 | ``` 34 | # enter nix shell to use postgres and redis installed by nix 35 | nix-shell 36 | 37 | # start redis 38 | redis-server --daemonize yes 39 | 40 | # start postgres, you only need to initdb and createdb for the first time 41 | initdb -D data -U postgres 42 | pg_ctl -D data -l logfile start 43 | createdb -U postgres ted2srt 44 | ``` 45 | 46 | One last step, create your own `.env` file and modify it to your needs. 47 | 48 | ``` 49 | cp .env.example .env 50 | ``` 51 | 52 | If `stack build` has finished now, run 53 | 54 | ``` 55 | stack exec ted2srt 56 | ``` 57 | 58 | to start the server. 59 | 60 | Then navigate to http://localhost:3001, try paste a TED talk url to the search bar, cheers. 61 | -------------------------------------------------------------------------------- /backend/.env.example: -------------------------------------------------------------------------------- 1 | export DEVELOPMENT=true 2 | export DB_CONN_STRING=postgresql://postgres:postgres@localhost/ted2srt 3 | export HOST=127.0.0.1 4 | export PORT=3001 5 | export REDIS_PORT=6379 6 | -------------------------------------------------------------------------------- /backend/.env.test: -------------------------------------------------------------------------------- 1 | DB_NAME=ted2srt_test 2 | DB_USER=postgres 3 | DB_PASSWORD= 4 | HOST=127.0.0.1 5 | PORT=3001 6 | REDIS_PORT=6379 7 | -------------------------------------------------------------------------------- /backend/.sosrc: -------------------------------------------------------------------------------- 1 | - patterns: 2 | - \.stack-work/install/.*/bin/ted2srt 3 | commands: 4 | - stack exec ted2srt -------------------------------------------------------------------------------- /backend/.stylish-haskell.yaml: -------------------------------------------------------------------------------- 1 | # stylish-haskell configuration file 2 | # ================================== 3 | 4 | # The stylish-haskell tool is mainly configured by specifying steps. These steps 5 | # are a list, so they have an order, and one specific step may appear more than 6 | # once (if needed). Each file is processed by these steps in the given order. 7 | steps: 8 | # Convert some ASCII sequences to their Unicode equivalents. This is disabled 9 | # by default. 10 | # - unicode_syntax: 11 | # # In order to make this work, we also need to insert the UnicodeSyntax 12 | # # language pragma. If this flag is set to true, we insert it when it's 13 | # # not already present. You may want to disable it if you configure 14 | # # language extensions using some other method than pragmas. Default: 15 | # # true. 16 | # add_language_pragma: true 17 | 18 | # Align the right hand side of some elements. This is quite conservative 19 | # and only applies to statements where each element occupies a single 20 | # line. 21 | - simple_align: 22 | cases: true 23 | top_level_patterns: true 24 | records: true 25 | 26 | # Import cleanup 27 | - imports: 28 | # There are different ways we can align names and lists. 29 | # 30 | # - global: Align the import names and import list throughout the entire 31 | # file. 32 | # 33 | # - file: Like global, but don't add padding when there are no qualified 34 | # imports in the file. 35 | # 36 | # - group: Only align the imports per group (a group is formed by adjacent 37 | # import lines). 38 | # 39 | # - none: Do not perform any alignment. 40 | # 41 | # Default: global. 42 | align: global 43 | 44 | # The following options affect only import list alignment. 45 | # 46 | # List align has following options: 47 | # 48 | # - after_alias: Import list is aligned with end of import including 49 | # 'as' and 'hiding' keywords. 50 | # 51 | # > import qualified Data.List as List (concat, foldl, foldr, head, 52 | # > init, last, length) 53 | # 54 | # - with_alias: Import list is aligned with start of alias or hiding. 55 | # 56 | # > import qualified Data.List as List (concat, foldl, foldr, head, 57 | # > init, last, length) 58 | # 59 | # - new_line: Import list starts always on new line. 60 | # 61 | # > import qualified Data.List as List 62 | # > (concat, foldl, foldr, head, init, last, length) 63 | # 64 | # Default: after_alias 65 | list_align: after_alias 66 | 67 | # Right-pad the module names to align imports in a group: 68 | # 69 | # - true: a little more readable 70 | # 71 | # > import qualified Data.List as List (concat, foldl, foldr, 72 | # > init, last, length) 73 | # > import qualified Data.List.Extra as List (concat, foldl, foldr, 74 | # > init, last, length) 75 | # 76 | # - false: diff-safe 77 | # 78 | # > import qualified Data.List as List (concat, foldl, foldr, init, 79 | # > last, length) 80 | # > import qualified Data.List.Extra as List (concat, foldl, foldr, 81 | # > init, last, length) 82 | # 83 | # Default: true 84 | pad_module_names: true 85 | 86 | # Long list align style takes effect when import is too long. This is 87 | # determined by 'columns' setting. 88 | # 89 | # - inline: This option will put as much specs on same line as possible. 90 | # 91 | # - new_line: Import list will start on new line. 92 | # 93 | # - new_line_multiline: Import list will start on new line when it's 94 | # short enough to fit to single line. Otherwise it'll be multiline. 95 | # 96 | # - multiline: One line per import list entry. 97 | # Type with constructor list acts like single import. 98 | # 99 | # > import qualified Data.Map as M 100 | # > ( empty 101 | # > , singleton 102 | # > , ... 103 | # > , delete 104 | # > ) 105 | # 106 | # Default: inline 107 | long_list_align: inline 108 | 109 | # Align empty list (importing instances) 110 | # 111 | # Empty list align has following options 112 | # 113 | # - inherit: inherit list_align setting 114 | # 115 | # - right_after: () is right after the module name: 116 | # 117 | # > import Vector.Instances () 118 | # 119 | # Default: inherit 120 | empty_list_align: inherit 121 | 122 | # List padding determines indentation of import list on lines after import. 123 | # This option affects 'long_list_align'. 124 | # 125 | # - : constant value 126 | # 127 | # - module_name: align under start of module name. 128 | # Useful for 'file' and 'group' align settings. 129 | list_padding: 4 130 | 131 | # Separate lists option affects formatting of import list for type 132 | # or class. The only difference is single space between type and list 133 | # of constructors, selectors and class functions. 134 | # 135 | # - true: There is single space between Foldable type and list of it's 136 | # functions. 137 | # 138 | # > import Data.Foldable (Foldable (fold, foldl, foldMap)) 139 | # 140 | # - false: There is no space between Foldable type and list of it's 141 | # functions. 142 | # 143 | # > import Data.Foldable (Foldable(fold, foldl, foldMap)) 144 | # 145 | # Default: true 146 | separate_lists: true 147 | 148 | # Space surround option affects formatting of import lists on a single 149 | # line. The only difference is single space after the initial 150 | # parenthesis and a single space before the terminal parenthesis. 151 | # 152 | # - true: There is single space associated with the enclosing 153 | # parenthesis. 154 | # 155 | # > import Data.Foo ( foo ) 156 | # 157 | # - false: There is no space associated with the enclosing parenthesis 158 | # 159 | # > import Data.Foo (foo) 160 | # 161 | # Default: false 162 | space_surround: false 163 | 164 | # Language pragmas 165 | - language_pragmas: 166 | # We can generate different styles of language pragma lists. 167 | # 168 | # - vertical: Vertical-spaced language pragmas, one per line. 169 | # 170 | # - compact: A more compact style. 171 | # 172 | # - compact_line: Similar to compact, but wrap each line with 173 | # `{-#LANGUAGE #-}'. 174 | # 175 | # Default: vertical. 176 | style: vertical 177 | 178 | # Align affects alignment of closing pragma brackets. 179 | # 180 | # - true: Brackets are aligned in same column. 181 | # 182 | # - false: Brackets are not aligned together. There is only one space 183 | # between actual import and closing bracket. 184 | # 185 | # Default: true 186 | align: true 187 | 188 | # stylish-haskell can detect redundancy of some language pragmas. If this 189 | # is set to true, it will remove those redundant pragmas. Default: true. 190 | # See https://github.com/jaspervdj/stylish-haskell/issues/75 191 | remove_redundant: false 192 | 193 | # Replace tabs by spaces. This is disabled by default. 194 | # - tabs: 195 | # # Number of spaces to use for each tab. Default: 8, as specified by the 196 | # # Haskell report. 197 | # spaces: 8 198 | 199 | # Remove trailing whitespace 200 | - trailing_whitespace: {} 201 | 202 | # A common setting is the number of columns (parts of) code will be wrapped 203 | # to. Different steps take this into account. Default: 80. 204 | columns: 80 205 | 206 | # By default, line endings are converted according to the OS. You can override 207 | # preferred format here. 208 | # 209 | # - native: Native newline format. CRLF on Windows, LF on other OSes. 210 | # 211 | # - lf: Convert to LF ("\n"). 212 | # 213 | # - crlf: Convert to CRLF ("\r\n"). 214 | # 215 | # Default: native. 216 | newline: native 217 | 218 | # Sometimes, language extensions are specified in a cabal file or from the 219 | # command line instead of using language pragmas in the file. stylish-haskell 220 | # needs to be aware of these, so it can parse the file correctly. 221 | # 222 | # No language extensions are enabled by default. 223 | language_extensions: 224 | - DataKinds 225 | - LambdaCase 226 | - NamedFieldPuns 227 | - QuasiQuotes 228 | - RecordWildCards 229 | - ScopedTypeVariables 230 | - TemplateHaskell 231 | - TypeFamilies 232 | -------------------------------------------------------------------------------- /backend/LICENSE: -------------------------------------------------------------------------------- 1 | This is free and unencumbered software released into the public domain. 2 | 3 | Anyone is free to copy, modify, publish, use, compile, sell, or 4 | distribute this software, either in source code form or as a compiled 5 | binary, for any purpose, commercial or non-commercial, and by any 6 | means. 7 | 8 | In jurisdictions that recognize copyright laws, the author or authors 9 | of this software dedicate any and all copyright interest in the 10 | software to the public domain. We make this dedication for the benefit 11 | of the public at large and to the detriment of our heirs and 12 | successors. We intend this dedication to be an overt act of 13 | relinquishment in perpetuity of all present and future rights to this 14 | software under copyright law. 15 | 16 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 17 | EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 18 | MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. 19 | IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR 20 | OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, 21 | ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR 22 | OTHER DEALINGS IN THE SOFTWARE. 23 | 24 | For more information, please refer to 25 | -------------------------------------------------------------------------------- /backend/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /backend/app/fetch.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | {-# LANGUAGE RecordWildCards #-} 3 | 4 | import qualified Data.Text as T 5 | import qualified Data.Text.IO.Utf8 as Utf8 6 | import Data.Time (getCurrentTime) 7 | import Database.Persist (Entity (..)) 8 | import LoadEnv (loadEnv) 9 | import Network.HTTP.Conduit (simpleHttp) 10 | import RIO 11 | import Text.HTML.DOM (parseLBS) 12 | import qualified Text.XML as X 13 | import Text.XML.Cursor 14 | 15 | import Config (Config (..), mkConfig) 16 | import Models.Talk (getTalks, saveToDB) 17 | import Types 18 | import Web.TED (Feed (..), FeedEntry (..), FileType (..), 19 | Subtitle (..), template, toSub) 20 | 21 | main :: IO () 22 | main = do 23 | loadEnv 24 | res <- simpleHttp rurl 25 | config <- mkConfig 26 | let cursor = fromDocument $ parseLBS res 27 | urls = take limit (parseUrl cursor) 28 | 29 | void $ runRIO config $ mapM saveToDB urls 30 | X.writeFile X.def "atom.xml" . template =<< mkFeed 31 | =<< saveAsFeed config 32 | where 33 | limit = 5 34 | rurl = "http://feeds.feedburner.com/tedtalks_video" 35 | -- 105 tids 36 | parseUrl :: Cursor -> [Text] 37 | parseUrl cur = cur $// element "feedburner:origLink" 38 | &// content 39 | 40 | 41 | talkToFeedEntry :: Entity Talk -> IO (Maybe FeedEntry) 42 | talkToFeedEntry (Entity _ Talk {..}) = do 43 | path <- toSub $ 44 | Subtitle 0 talkSlug ["en"] talkMediaSlug talkMediaPad TXT 45 | case path of 46 | Just path' -> do 47 | transcript <- T.drop 2 <$> Utf8.readFile path' 48 | return $ Just FeedEntry 49 | { feedEntryTitle = talkName 50 | , feedEntryLink = "http://ted2srt.org/talks/" <> talkSlug 51 | , feedEntryUpdated = talkPublishedAt 52 | , feedEntryContent = ppr transcript 53 | } 54 | Nothing -> return Nothing 55 | where 56 | ppr txt = T.concat $ map (\p -> "

" <> p <> "

") (T.lines txt) 57 | 58 | saveAsFeed :: Config -> IO [FeedEntry] 59 | saveAsFeed config = do 60 | talks <- runRIO config $ getTalks 0 5 61 | return . catMaybes =<< mapM talkToFeedEntry talks 62 | 63 | mkFeed :: [FeedEntry] -> IO Feed 64 | mkFeed entries = do 65 | time <- getCurrentTime 66 | return Feed 67 | { feedTitle = "TED2srt" 68 | , feedLinkSelf = "http://ted2srt.org/atom.xml" 69 | , feedLinkHome = "http://ted2srt.org" 70 | , feedAuthor = "rnons" 71 | , feedUpdated = time 72 | , feedEntries = entries 73 | } 74 | -------------------------------------------------------------------------------- /backend/app/main.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | {-# LANGUAGE TypeOperators #-} 3 | 4 | import LoadEnv (loadEnv) 5 | import Network.Wai (Application) 6 | import Network.Wai.Handler.Warp (run) 7 | import Network.Wai.Middleware.RequestLogger (logStdout) 8 | import Servant 9 | import Servant.Server (Handler, hoistServer) 10 | import System.Environment (getEnv) 11 | 12 | import Config (Config (..), mkConfig) 13 | import Control.Monad.Except (ExceptT (..)) 14 | import Database.Persist.Sql (ConnectionPool) 15 | import RIO hiding (Handler) 16 | import Server (allApi, getBundleH, 17 | tedApiView, tedServer) 18 | import Types 19 | 20 | 21 | app :: Config -> Application 22 | app config = logStdout $ serve allApi $ 23 | (hoistServer tedApiView nt (tedServer config)) :<|> getBundleH 24 | where 25 | nt :: AppM a -> Handler a 26 | nt (ExceptT foo) = 27 | Handler $ ExceptT $ runRIO config foo 28 | 29 | main :: IO () 30 | main = do 31 | loadEnv 32 | port <- read <$> getEnv "PORT" 33 | config <- mkConfig 34 | putStrLn $ "Server started at " <> show port 35 | run port $ app config 36 | -------------------------------------------------------------------------------- /backend/default.nix: -------------------------------------------------------------------------------- 1 | { nixpkgs ? import ../nix/nixpkgs.nix {} 2 | , compiler ? "ghc864" 3 | }: 4 | 5 | let 6 | overrides = import ../nix/all.nix { inherit nixpkgs compiler; }; 7 | in 8 | nixpkgs.pkgs.haskell.packages.${compiler}.callPackage ./ted2srt.nix overrides 9 | -------------------------------------------------------------------------------- /backend/deploy.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | ssh -t ted2srt '~/scripts/deploy.sh' 3 | -------------------------------------------------------------------------------- /backend/deploy/nginx.conf: -------------------------------------------------------------------------------- 1 | # nginx Configuration File 2 | # http://wiki.nginx.org/Configuration 3 | 4 | # Run as a less privileged user for security reasons. 5 | user www-data; 6 | 7 | # How many worker threads to run; 8 | # "auto" sets it to the number of CPU cores available in the system, and 9 | # offers the best performance. Don't set it higher than the number of CPU 10 | # cores if changing this parameter. 11 | 12 | # The maximum number of connections for Nginx is calculated by: 13 | # max_clients = worker_processes * worker_connections 14 | worker_processes 4; 15 | 16 | # Maximum open file descriptors per process; 17 | # should be > worker_connections. 18 | worker_rlimit_nofile 8192; 19 | 20 | events { 21 | # When you need > 8000 * cpu_cores connections, you start optimizing your OS, 22 | # and this is probably the point at which you hire people who are smarter than 23 | # you, as this is *a lot* of requests. 24 | worker_connections 8000; 25 | } 26 | 27 | # Default error log file 28 | # (this is only used when you don't override error_log on a server{} level) 29 | error_log /var/log/nginx/error.log warn; 30 | pid /run/nginx.pid; 31 | 32 | http { 33 | 34 | # Hide nginx version information. 35 | server_tokens off; 36 | 37 | # Define the MIME types for files. 38 | include /etc/nginx/mime.types; 39 | default_type application/octet-stream; 40 | 41 | # Update charset_types due to updated mime.types 42 | charset_types text/xml text/plain text/vnd.wap.wml application/x-javascript application/rss+xml text/css text/vtt application/javascript application/json; 43 | 44 | # Default log file 45 | # (this is only used when you don't override access_log on a server{} level) 46 | access_log /var/log/nginx/access.log; 47 | 48 | # How long to allow each connection to stay idle; longer values are better 49 | # for each individual client, particularly for SSL, but means that worker 50 | # connections are tied up longer. (Default: 65) 51 | keepalive_timeout 20; 52 | 53 | # Speed up file transfers by using sendfile() to copy directly 54 | # between descriptors rather than using read()/write(). 55 | sendfile on; 56 | 57 | # Tell Nginx not to send out partial frames; this increases throughput 58 | # since TCP frames are filled up before being sent out. (adds TCP_CORK) 59 | tcp_nopush on; 60 | 61 | 62 | # Compression 63 | 64 | # Enable Gzip compressed. 65 | gzip on; 66 | 67 | # Compression level (1-9). 68 | # 5 is a perfect compromise between size and cpu usage, offering about 69 | # 75% reduction for most ascii files (almost identical to level 9). 70 | gzip_comp_level 5; 71 | 72 | # Don't compress anything that's already small and unlikely to shrink much 73 | # if at all (the default is 20 bytes, which is bad as that usually leads to 74 | # larger files after gzipping). 75 | gzip_min_length 256; 76 | 77 | # Compress data even for clients that are connecting to us via proxies, 78 | # identified by the "Via" header (required for CloudFront). 79 | gzip_proxied any; 80 | 81 | # Tell proxies to cache both the gzipped and regular version of a resource 82 | # whenever the client's Accept-Encoding capabilities header varies; 83 | # Avoids the issue where a non-gzip capable client (which is extremely rare 84 | # today) would display gibberish if their proxy gave them the gzipped version. 85 | gzip_vary on; 86 | 87 | # Compress all output labeled with one of the following MIME-types. 88 | gzip_types 89 | application/atom+xml 90 | application/javascript 91 | application/json 92 | application/ld+json 93 | application/manifest+json 94 | application/rdf+xml 95 | application/rss+xml 96 | application/schema+json 97 | application/vnd.geo+json 98 | application/vnd.ms-fontobject 99 | application/x-font-ttf 100 | application/x-javascript 101 | application/x-web-app-manifest+json 102 | application/xhtml+xml 103 | application/xml 104 | font/eot 105 | font/opentype 106 | image/bmp 107 | image/svg+xml 108 | image/vnd.microsoft.icon 109 | image/x-icon 110 | text/cache-manifest 111 | text/css 112 | text/javascript 113 | text/plain 114 | text/vcard 115 | text/vnd.rim.location.xloc 116 | text/vtt 117 | text/x-component 118 | text/x-cross-domain-policy 119 | text/xml; 120 | # text/html is always compressed by HttpGzipModule 121 | 122 | # This should be turned on if you are going to have pre-compressed copies (.gz) of 123 | # static files available. If not it should be left off as it will cause extra I/O 124 | # for the check. It is best if you enable this in a location{} block for 125 | # a specific directory, or on an individual server{} level. 126 | # gzip_static on; 127 | 128 | include /etc/nginx/sites-enabled/*; 129 | 130 | limit_req_zone $binary_remote_addr zone=api:10m rate=2r/s; 131 | 132 | server { 133 | listen 80; 134 | listen [::]:80; 135 | server_name www.ted2srt.org; 136 | return 301 $scheme://ted2srt.org$request_uri; 137 | } 138 | 139 | server { 140 | listen 80; 141 | listen [::]:80; 142 | server_name ted2srt.org; 143 | return 301 https://ted2srt.org$request_uri; 144 | } 145 | 146 | server { 147 | listen 443 ssl http2; 148 | listen [::]:443 ssl http2; 149 | server_name ted2srt.org; 150 | ssl_certificate /etc/letsencrypt/live/ted2srt.org/fullchain.pem; 151 | ssl_certificate_key /etc/letsencrypt/live/ted2srt.org/privkey.pem; 152 | 153 | location / { 154 | proxy_pass http://127.0.0.1:3001/; 155 | proxy_set_header Host $http_host; 156 | proxy_set_header X-Real-IP $remote_addr; 157 | proxy_set_header X-Forwarded-For $proxy_add_x_forwarded_for; 158 | } 159 | 160 | location /api { 161 | proxy_pass http://127.0.0.1:3001/api/; 162 | proxy_set_header Host $http_host; 163 | proxy_set_header X-Real-IP $remote_addr; 164 | proxy_set_header X-Forwarded-For $proxy_add_x_forwarded_for; 165 | limit_req zone=api burst=3; 166 | } 167 | 168 | location /favicon.ico { 169 | root /opt/ted2srt/dist; 170 | } 171 | 172 | location /atom.xml { 173 | root /opt/ted2srt/; 174 | } 175 | 176 | location /dist/.* { 177 | root /opt/ted2srt/dist; 178 | } 179 | 180 | location /.well-known/ { 181 | root /opt/ted2srt; 182 | } 183 | } 184 | } 185 | -------------------------------------------------------------------------------- /backend/dist/favicon.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rnons/ted2srt/7456f109bce2b9f07d0c929bef2fd42e6bc4f75d/backend/dist/favicon.ico -------------------------------------------------------------------------------- /backend/dist/icon.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rnons/ted2srt/7456f109bce2b9f07d0c929bef2fd42e6bc4f75d/backend/dist/icon.png -------------------------------------------------------------------------------- /backend/dist/search.xml: -------------------------------------------------------------------------------- 1 | 2 | TED2srt 3 | Download bilingual subtitles of TED talks 4 | UTF-8 5 | https://ted2srt.org/favicon.ico 6 | 7 | 8 | -------------------------------------------------------------------------------- /backend/package.yaml: -------------------------------------------------------------------------------- 1 | name: ted2srt 2 | version: "3.20200412" 3 | 4 | dependencies: 5 | 6 | # Due to a bug in GHC 8.0.1, we block its usage 7 | # See: https://ghc.haskell.org/trac/ghc/ticket/12130 8 | - base >=4.8.2.0 && <4.9 || >=4.9.1.0 && <5 9 | 10 | - aeson 11 | - base64-bytestring 12 | - bytestring 13 | - conduit 14 | - conduit-extra 15 | - containers 16 | - cryptonite 17 | - cryptonite-conduit 18 | - directory 19 | - either 20 | - hedis 21 | - html-conduit 22 | - http-conduit 23 | - http-types 24 | - load-env 25 | - lucid 26 | - memory 27 | - monad-logger 28 | - mtl 29 | - network 30 | - persistent 31 | - persistent-postgresql 32 | - persistent-template 33 | - raw-strings-qq 34 | - regex-posix 35 | - rio 36 | - servant-lucid 37 | - servant-server 38 | - system-filepath 39 | - text 40 | - time 41 | - transformers 42 | - unordered-containers 43 | - vector 44 | - wai 45 | - with-utf8 46 | - xml-conduit 47 | 48 | # The library contains all of our application code. The executable 49 | # defined below is just a thin wrapper. 50 | library: 51 | source-dirs: src 52 | default-extensions: 53 | - DataKinds 54 | - DeriveGeneric 55 | - FlexibleInstances 56 | - LambdaCase 57 | - NamedFieldPuns 58 | - NoImplicitPrelude 59 | - OverloadedStrings 60 | - QuasiQuotes 61 | - RecordWildCards 62 | - ScopedTypeVariables 63 | - TemplateHaskell 64 | - TypeFamilies 65 | ghc-options: 66 | - -Wall 67 | - -fwarn-tabs 68 | 69 | # Runnable executable for our application 70 | executables: 71 | fetch: 72 | main: fetch.hs 73 | source-dirs: app 74 | ghc-options: 75 | - -threaded 76 | - -rtsopts 77 | - -with-rtsopts=-N 78 | dependencies: 79 | - ted2srt 80 | 81 | ted2srt: 82 | main: main.hs 83 | source-dirs: app 84 | ghc-options: 85 | - -threaded 86 | - -rtsopts 87 | - -with-rtsopts=-N 88 | dependencies: 89 | - ted2srt 90 | - warp 91 | - wai-extra 92 | 93 | # Test suite 94 | # tests: 95 | # test: 96 | # main: Main.hs 97 | # source-dirs: test 98 | # default-extensions: 99 | # - NoImplicitPrelude 100 | # - OverloadedStrings 101 | # ghc-options: -Wall 102 | # dependencies: 103 | # - ted2srt 104 | # - hspec >=2.0.0 105 | # - process 106 | -------------------------------------------------------------------------------- /backend/scripts/cabal2nix.sh: -------------------------------------------------------------------------------- 1 | hpack 2 | cabal2nix --no-haddock . > ted2srt.nix 3 | sed -i '0,/}/ s/}/, postgresql_11}/' ted2srt.nix 4 | sed -i '0,/.*libraryToolDepends.*/ s/.*libraryToolDepends.*/ librarySystemDepends = [ postgresql_11 ];\n&/' ted2srt.nix 5 | -------------------------------------------------------------------------------- /backend/shell.nix: -------------------------------------------------------------------------------- 1 | { nixpkgs ? import ../nix/nixpkgs.nix {} 2 | , ghc ? nixpkgs.ghc 3 | }: 4 | 5 | with nixpkgs; 6 | 7 | let 8 | nativeLibs = [ 9 | gmp 10 | postgresql_11 11 | redis 12 | zlib 13 | ] ++ lib.optionals stdenv.isDarwin (with darwin.apple_sdk.frameworks; [ 14 | Cocoa 15 | CoreServices 16 | ]); 17 | 18 | in haskell.lib.buildStackProject { 19 | inherit ghc; 20 | 21 | name = "ted2srt"; 22 | 23 | buildInputs = nativeLibs; 24 | } 25 | -------------------------------------------------------------------------------- /backend/sql/latest.sql: -------------------------------------------------------------------------------- 1 | -- 2 | -- PostgreSQL database dump 3 | -- 4 | 5 | -- Dumped from database version 9.5.2 6 | -- Dumped by pg_dump version 9.5.2 7 | 8 | SET statement_timeout = 0; 9 | SET lock_timeout = 0; 10 | SET client_encoding = 'UTF8'; 11 | SET standard_conforming_strings = on; 12 | SET check_function_bodies = false; 13 | SET client_min_messages = warning; 14 | SET row_security = off; 15 | 16 | SET search_path = public, pg_catalog; 17 | 18 | ALTER TABLE ONLY public.transcript DROP CONSTRAINT transcript_id_fkey1; 19 | ALTER TABLE ONLY public.transcript DROP CONSTRAINT transcript_id_fkey; 20 | DROP INDEX public.en_idx; 21 | ALTER TABLE ONLY public.transcript DROP CONSTRAINT transcript_pkey; 22 | ALTER TABLE ONLY public.talk DROP CONSTRAINT talk_pkey; 23 | ALTER TABLE ONLY public.talk DROP CONSTRAINT talk_id_name_key; 24 | DROP TABLE public.transcript; 25 | DROP TABLE public.talk; 26 | DROP EXTENSION plpgsql; 27 | DROP SCHEMA public; 28 | -- 29 | -- Name: public; Type: SCHEMA; Schema: -; Owner: postgres 30 | -- 31 | 32 | CREATE SCHEMA public; 33 | 34 | 35 | ALTER SCHEMA public OWNER TO postgres; 36 | 37 | -- 38 | -- Name: SCHEMA public; Type: COMMENT; Schema: -; Owner: postgres 39 | -- 40 | 41 | COMMENT ON SCHEMA public IS 'standard public schema'; 42 | 43 | 44 | -- 45 | -- Name: plpgsql; Type: EXTENSION; Schema: -; Owner: 46 | -- 47 | 48 | CREATE EXTENSION IF NOT EXISTS plpgsql WITH SCHEMA pg_catalog; 49 | 50 | 51 | -- 52 | -- Name: EXTENSION plpgsql; Type: COMMENT; Schema: -; Owner: 53 | -- 54 | 55 | COMMENT ON EXTENSION plpgsql IS 'PL/pgSQL procedural language'; 56 | 57 | 58 | SET search_path = public, pg_catalog; 59 | 60 | SET default_tablespace = ''; 61 | 62 | SET default_with_oids = false; 63 | 64 | -- 65 | -- Name: talk; Type: TABLE; Schema: public; Owner: postgres 66 | -- 67 | 68 | CREATE TABLE talk ( 69 | id int NOT NULL, 70 | name text, 71 | slug text, 72 | filmed_at timestamp with time zone, 73 | published_at timestamp with time zone, 74 | description text, 75 | image text, 76 | languages jsonb, 77 | media_slug text, 78 | media_pad real 79 | ); 80 | 81 | 82 | ALTER TABLE talk OWNER TO postgres; 83 | 84 | -- 85 | -- Name: transcript; Type: TABLE; Schema: public; Owner: postgres 86 | -- 87 | 88 | CREATE TABLE transcript ( 89 | id int NOT NULL, 90 | en_tsvector tsvector 91 | ); 92 | 93 | 94 | ALTER TABLE transcript OWNER TO postgres; 95 | 96 | -- 97 | -- Name: talk_id_name_key; Type: CONSTRAINT; Schema: public; Owner: postgres 98 | -- 99 | 100 | ALTER TABLE ONLY talk 101 | ADD CONSTRAINT talk_id_name_key UNIQUE (id, name); 102 | 103 | 104 | -- 105 | -- Name: talk_pkey; Type: CONSTRAINT; Schema: public; Owner: postgres 106 | -- 107 | 108 | ALTER TABLE ONLY talk 109 | ADD CONSTRAINT talk_pkey PRIMARY KEY (id); 110 | 111 | 112 | -- 113 | -- Name: transcript_pkey; Type: CONSTRAINT; Schema: public; Owner: postgres 114 | -- 115 | 116 | ALTER TABLE ONLY transcript 117 | ADD CONSTRAINT transcript_pkey PRIMARY KEY (id); 118 | 119 | 120 | -- 121 | -- Name: en_idx; Type: INDEX; Schema: public; Owner: postgres 122 | -- 123 | 124 | CREATE INDEX en_idx ON transcript USING gin (en_tsvector); 125 | 126 | 127 | -- 128 | -- Name: transcript_id_fkey; Type: FK CONSTRAINT; Schema: public; Owner: postgres 129 | -- 130 | 131 | ALTER TABLE ONLY transcript 132 | ADD CONSTRAINT transcript_id_fkey FOREIGN KEY (id) REFERENCES talk(id) ON DELETE CASCADE; 133 | 134 | 135 | -- 136 | -- PostgreSQL database dump complete 137 | -- 138 | -------------------------------------------------------------------------------- /backend/sql/pg_dump.sh: -------------------------------------------------------------------------------- 1 | pg_dump -d ted2srt -c -s -x > sql/latest.sql 2 | -------------------------------------------------------------------------------- /backend/src/Api/Search.hs: -------------------------------------------------------------------------------- 1 | module Api.Search 2 | ( getSearchApiH 3 | ) where 4 | 5 | import qualified Data.Text as T 6 | import Database.Persist (Entity, (||.)) 7 | import qualified Database.Persist as P 8 | import Model 9 | import RIO 10 | import Servant (err400, throwError) 11 | import Types (AppM, AppRIO, runDB) 12 | 13 | 14 | -- Based on https://stackoverflow.com/a/11069667 15 | ilike :: EntityField record Text -> Text -> P.Filter record 16 | ilike field q = 17 | P.Filter field (Left query) (P.BackendSpecificFilter "ilike") 18 | where 19 | q' = T.map (\c -> if c == '_' then ' ' else c) q 20 | query = "%" <> T.intercalate "%" (T.words q') <> "%" 21 | 22 | searchTalk :: Text -> AppRIO [Entity Talk] 23 | searchTalk q = do 24 | runDB $ P.selectList ([TalkName `ilike` q] ||. [TalkDescription `ilike` q]) [] 25 | 26 | getSearchApiH :: Maybe Text -> AppM [Entity Talk] 27 | getSearchApiH (Just q) = lift $ searchTalk q 28 | getSearchApiH Nothing = throwError err400 29 | -------------------------------------------------------------------------------- /backend/src/Api/Subtitles.hs: -------------------------------------------------------------------------------- 1 | module Api.Subtitles 2 | ( getSubtitleH 3 | , downloadSubtitleH 4 | ) where 5 | 6 | import qualified Data.ByteString.Char8 as C 7 | import Database.Persist (Entity (..)) 8 | import qualified Filesystem.Path.CurrentOS as FS 9 | import Models.Talk (getTalkById) 10 | import Network.HTTP.Types (status200, status404) 11 | import Network.Wai (Application, Response, responseFile, 12 | responseLBS) 13 | import RIO 14 | import Types 15 | import Web.TED (FileType (..), Subtitle (..), toSub) 16 | 17 | 18 | getSubtitlePath :: Int -> FileType -> [Text] -> RIO Config (Maybe FilePath) 19 | getSubtitlePath tid format lang = do 20 | mTalk <- getTalkById tid Nothing 21 | case mTalk of 22 | Just (Entity _ Talk {..}) -> liftIO $ toSub $ 23 | Subtitle tid talkSlug lang talkMediaSlug talkMediaPad format 24 | Nothing -> return Nothing 25 | 26 | notFound :: (Response -> t) -> t 27 | notFound respond = respond $ responseLBS status404 [] "Not Found" 28 | 29 | getSubtitleH :: Config -> Int -> FileType -> [Text] -> Application 30 | getSubtitleH config tid format lang _ respond = do 31 | let cType = if format == VTT then "text/vtt" else "text/plain" 32 | path <- runRIO config $ getSubtitlePath tid format lang 33 | case path of 34 | Just p -> respond $ responseFile status200 [("Content-Type", cType)] p Nothing 35 | Nothing -> notFound respond 36 | 37 | downloadSubtitleH :: Config -> Int -> FileType -> [Text] -> Application 38 | downloadSubtitleH config tid format lang _ respond = do 39 | path <- runRIO config $ getSubtitlePath tid format lang 40 | case path of 41 | Just p -> do 42 | let filename = C.pack $ FS.encodeString $ FS.filename $ FS.decodeString p 43 | respond $ responseFile 44 | status200 45 | [ ("Content-Type", "text/plain") 46 | , ("Content-Disposition", "attachment; filename=" <> filename)] 47 | p 48 | Nothing 49 | Nothing -> notFound respond 50 | -------------------------------------------------------------------------------- /backend/src/Api/Talks.hs: -------------------------------------------------------------------------------- 1 | module Api.Talks 2 | ( getRandomTalkApiH 3 | , getTalkApiH 4 | , getTalksApiH 5 | ) where 6 | 7 | import Database.Persist (Entity (..)) 8 | import Models.Talk (getTalkBySlug, getTalks) 9 | import RIO 10 | import Servant (err404, throwError) 11 | import Types 12 | 13 | 14 | getTalksApiH :: Maybe Int -> Maybe Int -> AppM [Entity Talk] 15 | getTalksApiH mOffset mLimit = do 16 | lift $ getTalks offset limit 17 | where 18 | defaultLimit = 20 19 | maxLimit = 20 20 | offset = fromMaybe 0 mOffset 21 | limit = maybe defaultLimit (\i -> if i > maxLimit then maxLimit else i) mLimit 22 | 23 | getRandomTalkApiH :: AppM Talk 24 | getRandomTalkApiH = do 25 | let xs = [] 26 | -- xs <- liftIO $ Pg.query_ dbConn [sql| 27 | -- SELECT * FROM talk 28 | -- TABLESAMPLE SYSTEM (1) 29 | -- LIMIT 1 30 | -- |] 31 | case xs of 32 | [talk] -> pure $ entityVal talk 33 | _ -> throwM err404 34 | 35 | getTalkApiH :: Text -> AppM Talk 36 | getTalkApiH slug = do 37 | mTalk <- lift $ getTalkBySlug slug 38 | case mTalk of 39 | Just talk -> pure $ entityVal talk 40 | Nothing -> throwError err404 41 | -------------------------------------------------------------------------------- /backend/src/Config.hs: -------------------------------------------------------------------------------- 1 | module Config where 2 | 3 | import qualified Control.Monad.Logger as Logger 4 | import qualified Data.ByteString.Char8 as C 5 | import Data.Maybe (fromMaybe) 6 | import qualified Database.Persist.Postgresql as PG 7 | import Database.Persist.Sql (ConnectionPool) 8 | import qualified Database.Redis as KV 9 | import Model 10 | import Network.HTTP.Client.Conduit (HasHttpManager (..), Manager, 11 | newManager) 12 | import Network.Socket (PortNumber) 13 | import RIO 14 | import Static 15 | import System.Environment (getEnv) 16 | import System.IO (print) 17 | 18 | data Config = Config 19 | { devMode :: Bool 20 | , dbPool :: ConnectionPool 21 | , kvConn :: KV.Connection 22 | , httpManager :: Manager 23 | , logFunc :: LogFunc 24 | , lookupStatic :: LookupStatic 25 | } 26 | 27 | instance HasHttpManager Config where 28 | getHttpManager = httpManager 29 | 30 | instance HasLogFunc Config where 31 | logFuncL = lens logFunc (\x y -> x { logFunc = y }) 32 | 33 | mkConfig :: IO Config 34 | mkConfig = do 35 | devMode <- (== "true") <$> getEnv "DEVELOPMENT" 36 | dbConnString <- getEnv "DB_CONN_STRING" 37 | (kvPort :: PortNumber) <- (fromMaybe 6369) <$> readMaybe <$> getEnv "REDIS_PORT" 38 | kv <- KV.checkedConnect KV.defaultConnectInfo 39 | { KV.connectPort = KV.PortNumber $ fromIntegral kvPort } 40 | httpManager <- newManager 41 | logOptions <- logOptionsHandle stderr True 42 | 43 | let 44 | emptyLogFunc _ _ _ _ = pure () 45 | logFunc loc source level str = 46 | print $ Logger.defaultLogStr loc source level str 47 | pool <- flip Logger.runLoggingT (if devMode then logFunc else emptyLogFunc) $ 48 | PG.createPostgresqlPool (C.pack dbConnString) 10 49 | Logger.runLoggingT (PG.runSqlPool (PG.runMigration migrateAll) pool) logFunc 50 | 51 | lookupStatic <- static 52 | withLogFunc logOptions $ \lf -> 53 | pure $ Config devMode pool kv httpManager lf lookupStatic 54 | -------------------------------------------------------------------------------- /backend/src/Model.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE GADTs #-} 2 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 3 | {-# LANGUAGE MultiParamTypeClasses #-} 4 | {-# LANGUAGE QuasiQuotes #-} 5 | {-# LANGUAGE TemplateHaskell #-} 6 | 7 | module Model where 8 | 9 | import Data.Aeson (FromJSON, ToJSON, Value) 10 | import Database.Persist.Postgresql.JSON () 11 | import Database.Persist.TH 12 | import RIO 13 | import RIO.Time (UTCTime) 14 | 15 | data Language = Language 16 | { languageName :: Text 17 | , languageCode :: Text 18 | , endonym :: Text 19 | } deriving (Generic) 20 | instance FromJSON Language 21 | instance ToJSON Language 22 | 23 | share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase| 24 | Talk json 25 | Id Int sql=id 26 | name Text 27 | slug Text 28 | filmedAt UTCTime 29 | publishedAt UTCTime 30 | description Text 31 | image Text 32 | languages Value 33 | mediaSlug Text 34 | mediaPad Double 35 | |] 36 | -------------------------------------------------------------------------------- /backend/src/Models/RedisKeys.hs: -------------------------------------------------------------------------------- 1 | module Models.RedisKeys where 2 | 3 | import qualified Data.ByteString.Char8 as C 4 | import qualified Data.Text as T 5 | import RIO 6 | 7 | 8 | cache :: Int -> C.ByteString 9 | cache = C.pack . show 10 | 11 | slug :: Text -> C.ByteString 12 | slug = C.pack . T.unpack 13 | -------------------------------------------------------------------------------- /backend/src/Models/Talk.hs: -------------------------------------------------------------------------------- 1 | module Models.Talk where 2 | 3 | import Control.Monad (liftM, mzero, void) 4 | import Data.Aeson 5 | import qualified Data.ByteString.Char8 as C 6 | import Data.Text (Text) 7 | import qualified Data.Text as T 8 | import qualified Data.Text.Read as T 9 | import Data.Time (UTCTime) 10 | import Data.Time.Clock.POSIX (posixSecondsToUTCTime) 11 | import Database.Persist 12 | import qualified Database.Redis as KV 13 | import GHC.Generics (Generic) 14 | import Network.HTTP.Client.Conduit (HttpException, httpLbs, 15 | parseUrlThrow, responseBody) 16 | import RIO hiding (id) 17 | import Text.HTML.DOM (parseLBS) 18 | import Text.XML.Cursor (fromDocument) 19 | import Types (AppRIO, runDB) 20 | 21 | import Config (Config (..)) 22 | import Model 23 | import qualified Models.RedisKeys as Keys 24 | import Models.Types (mkTalkUrl) 25 | import Web.TED.TalkPage (parseDescription, parseImage, 26 | parseTalkObject) 27 | 28 | 29 | data TalkObj = TalkObj 30 | { id :: Int 31 | , name :: Text 32 | , slug :: Text 33 | , filmedAt :: UTCTime 34 | , publishedAt :: UTCTime 35 | , languages :: [Language] 36 | , mediaSlug :: Text 37 | } deriving (Generic) 38 | 39 | instance FromJSON TalkObj where 40 | parseJSON (Object v) = do 41 | idText <- v .: "id" 42 | tid <- case fst <$> T.decimal idText of 43 | Right tid -> pure tid 44 | _ -> fail "id is not int" 45 | TalkObj 46 | <$> pure tid 47 | <*> v .: "name" 48 | <*> v .: "slug" 49 | <*> liftM posixSecondsToUTCTime (v .: "published") 50 | <*> liftM posixSecondsToUTCTime (v .: "published") 51 | <*> v .: "languages" 52 | <*> v .: "mediaIdentifier" 53 | parseJSON _ = mzero 54 | 55 | 56 | getTalks :: Int -> Int -> AppRIO [Entity Talk] 57 | getTalks offset limit = do 58 | runDB $ selectList [] 59 | [ Desc TalkId 60 | , LimitTo limit 61 | , OffsetBy offset 62 | ] 63 | 64 | getTalk :: Int -> Text -> AppRIO (Maybe (Entity Talk)) 65 | getTalk tid url = do 66 | Config { kvConn } <- ask 67 | cached <- liftIO $ KV.runRedis kvConn $ 68 | KV.get $ Keys.cache $ fromIntegral tid 69 | case cached of 70 | Right (Just _) -> getTalkById tid (Just url) 71 | Right Nothing -> saveToDB url 72 | Left _ -> saveToDB url 73 | 74 | getTalkById :: Int -> Maybe Text -> AppRIO (Maybe (Entity Talk)) 75 | getTalkById tid mUrl = do 76 | xs <- runDB $ getEntity $ TalkKey tid 77 | case xs of 78 | Just talk -> return $ Just talk 79 | _ -> maybe (return Nothing) saveToDB mUrl 80 | 81 | hush :: Either a b -> Maybe b 82 | hush (Left _) = Nothing 83 | hush (Right v) = Just v 84 | 85 | getTalkBySlug :: Text -> AppRIO (Maybe (Entity Talk)) 86 | getTalkBySlug slug = do 87 | Config { kvConn } <- ask 88 | mtid <- liftIO $ fmap (join . hush) <$> KV.runRedis kvConn $ KV.get $ Keys.slug slug 89 | case mtid of 90 | Just tid -> 91 | case readMaybe $ C.unpack tid of 92 | Just tid' -> getTalk tid' url 93 | Nothing -> pure Nothing 94 | Nothing -> 95 | saveToDB url 96 | where 97 | url = mkTalkUrl slug 98 | 99 | saveToDB :: Text -> AppRIO (Maybe (Entity Talk)) 100 | saveToDB url = do 101 | Config{..} <- ask 102 | mTalk <- fetchTalk url 103 | case mTalk of 104 | Just entity@(Entity talkId talk) -> do 105 | void $ liftIO $ KV.runRedis kvConn $ KV.multiExec $ do 106 | void $ KV.setex (Keys.cache $ unTalkKey talkId) (3600*24) "" 107 | KV.set (Keys.slug $ talkSlug talk) (C.pack $ show $ unTalkKey talkId) 108 | 109 | runDB $ repsert talkId talk 110 | return $ Just entity 111 | Nothing -> return Nothing 112 | 113 | fetchTalk :: Text -> AppRIO (Maybe (Entity Talk)) 114 | fetchTalk url = do 115 | handle (\(_::HttpException) -> return Nothing) $ do 116 | req <- parseUrlThrow $ T.unpack url 117 | res <- httpLbs req 118 | let 119 | body = responseBody res 120 | cursor = fromDocument $ parseLBS body 121 | desc = parseDescription cursor 122 | img = parseImage cursor 123 | core = parseTalkObject body 124 | case eitherDecode core of 125 | Right TalkObj{..} -> do 126 | return $ Just $ Entity (TalkKey $ fromIntegral id) (Talk 127 | { talkName = name 128 | , talkSlug = slug 129 | , talkFilmedAt = filmedAt 130 | , talkPublishedAt = publishedAt 131 | , talkDescription = desc 132 | , talkImage = img 133 | , talkLanguages = toJSON languages 134 | , talkMediaSlug = mediaSlug 135 | , talkMediaPad = 0.0 136 | }) 137 | Left err -> do 138 | logErrorS "fetchTalk" $ fromString err 139 | pure Nothing 140 | -------------------------------------------------------------------------------- /backend/src/Models/Types.hs: -------------------------------------------------------------------------------- 1 | module Models.Types where 2 | 3 | import RIO 4 | 5 | mkTalkUrl :: Text -> Text 6 | mkTalkUrl s = "http://www.ted.com/talks/" <> s 7 | -------------------------------------------------------------------------------- /backend/src/Server.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -fno-warn-orphans #-} 2 | {-# LANGUAGE TypeOperators #-} 3 | module Server 4 | ( tedApiView 5 | , tedServer 6 | , allApi 7 | , getBundleH 8 | ) where 9 | 10 | import Api.Search (getSearchApiH) 11 | import Api.Subtitles (downloadSubtitleH, getSubtitleH) 12 | import Api.Talks (getRandomTalkApiH, getTalkApiH, 13 | getTalksApiH) 14 | import Config (Config (..)) 15 | import Database.Persist (Entity (..)) 16 | import Lucid 17 | import RIO hiding (Handler) 18 | import Servant 19 | import Servant.HTML.Lucid (HTML) 20 | import Types (AppM) 21 | import Types 22 | import View.Home (getHomeH) 23 | import View.Search (getSearchH) 24 | import View.Talk (getTalkH) 25 | import Web.TED (FileType (..)) 26 | 27 | 28 | instance FromHttpApiData FileType where 29 | parseUrlPiece "srt" = Right SRT 30 | parseUrlPiece "vtt" = Right VTT 31 | parseUrlPiece "txt" = Right TXT 32 | parseUrlPiece "lrc" = Right LRC 33 | parseUrlPiece _ = Left "Unsupported" 34 | 35 | type TedApi = 36 | "talks" 37 | :> QueryParam "offset" Int -- ^ getTalksH 38 | :> QueryParam "limit" Int 39 | :> Get '[JSON] [Entity Talk] 40 | :<|> "talks" :> "random" 41 | :> Get '[JSON] Talk 42 | :<|> "talks" 43 | :> Capture "slug" Text -- ^ getTalkH 44 | :> Get '[JSON] Talk 45 | :<|> "talks" 46 | :> Capture "tid" Int -- ^ getSubtitleH 47 | :> "transcripts" 48 | :> Capture "format" FileType 49 | :> QueryParams "lang" Text 50 | :> Raw 51 | :<|> "talks" 52 | :> Capture "tid" Int -- ^ downloadTalkSubtitleH 53 | :> "transcripts" 54 | :> "download" 55 | :> Capture "format" FileType 56 | :> QueryParams "lang" Text 57 | :> Raw 58 | :<|> "search" 59 | :> QueryParam "q" Text :> Get '[JSON] [Entity Talk] 60 | 61 | type TedView = 62 | Get '[HTML] (Html ()) 63 | :<|> "talks" :> Capture "slug" Text :> Get '[HTML] (Html ()) 64 | :<|> "search" :> QueryParam "q" Text :> Get '[HTML] (Html ()) 65 | 66 | type TedApiView = 67 | "api" :> TedApi 68 | :<|> TedView 69 | 70 | type AllApi = 71 | TedApiView 72 | :<|> "dist" :> Raw 73 | 74 | getBundleH :: Server Raw 75 | getBundleH = serveDirectoryWebApp "dist" 76 | 77 | tedApiView :: Proxy TedApiView 78 | tedApiView = Proxy 79 | 80 | allApi :: Proxy AllApi 81 | allApi = Proxy 82 | 83 | tedApiServer :: Config -> ServerT TedApi AppM 84 | tedApiServer config = 85 | getTalksApiH 86 | :<|> getRandomTalkApiH 87 | :<|> getTalkApiH 88 | :<|> (\tid format lang -> Tagged (getSubtitleH config tid format lang)) 89 | :<|> (\tid format lang -> Tagged (downloadSubtitleH config tid format lang)) 90 | :<|> getSearchApiH 91 | 92 | 93 | tedViewServer :: ServerT TedView AppM 94 | tedViewServer = 95 | getHomeH 96 | :<|> getTalkH 97 | :<|> getSearchH 98 | 99 | tedServer :: Config -> ServerT TedApiView AppM 100 | tedServer config = 101 | tedApiServer config 102 | :<|> tedViewServer 103 | -------------------------------------------------------------------------------- /backend/src/Static.hs: -------------------------------------------------------------------------------- 1 | module Static where 2 | 3 | import Crypto.Hash (Digest, MD5) 4 | import Crypto.Hash.Conduit (hashFile) 5 | import qualified Data.ByteArray as ByteArray 6 | import qualified Data.ByteString as S 7 | import qualified Data.ByteString.Base64 8 | import qualified Data.ByteString.Char8 as S8 9 | import qualified Data.Map as M 10 | import RIO 11 | 12 | staticDir :: String 13 | staticDir = "dist" 14 | 15 | bundles :: [String] 16 | bundles = 17 | [ "common.js" 18 | , "common.css" 19 | , "Home.js" 20 | , "Home.css" 21 | , "Talk.js" 22 | , "Talk.css" 23 | , "Search.js" 24 | , "Search.css" 25 | ] 26 | 27 | type LookupStatic = String -> String 28 | 29 | static :: IO LookupStatic 30 | static = do 31 | cache <- mkHashMap 32 | pure $ \filename -> 33 | case (M.lookup filename cache) of 34 | Nothing -> filename 35 | Just hash -> filename <> "?etag=" <> hash 36 | 37 | mkHashMap :: IO (M.Map FilePath String) 38 | mkHashMap = do 39 | mapM hashFile' bundles >>= return . M.fromList 40 | where 41 | hashFile' :: String -> IO (FilePath, String) 42 | hashFile' filename = do 43 | let filepath = staticDir ++ '/' : filename 44 | h <- base64md5File filepath 45 | pure (filename, h) 46 | 47 | base64md5File :: FilePath -> IO String 48 | base64md5File = fmap (base64 . encode) . hashFile 49 | where encode d = ByteArray.convert (d :: Digest MD5) 50 | 51 | base64 :: S.ByteString -> String 52 | base64 = map tr 53 | . take 8 54 | . S8.unpack 55 | . Data.ByteString.Base64.encode 56 | where 57 | tr '+' = '-' 58 | tr '/' = '_' 59 | tr c = c 60 | -------------------------------------------------------------------------------- /backend/src/Types.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleContexts #-} 2 | 3 | module Types 4 | ( AppRIO 5 | , AppM 6 | , runDB 7 | , module X 8 | ) where 9 | 10 | import Config as X (Config (..)) 11 | import Control.Monad.Except (ExceptT) 12 | import qualified Database.Persist.Postgresql as PG 13 | import Database.Persist.Sql (SqlPersistT) 14 | import Model as X (Talk (..)) 15 | import RIO 16 | import Servant (ServantErr) 17 | 18 | type AppRIO = RIO Config 19 | 20 | type AppM = ExceptT ServantErr (RIO Config) 21 | 22 | runDB :: SqlPersistT AppRIO a -> AppRIO a 23 | runDB action = do 24 | Config { dbPool } <- ask 25 | PG.runSqlPool action dbPool 26 | -------------------------------------------------------------------------------- /backend/src/View/Bundle.hs: -------------------------------------------------------------------------------- 1 | module View.Bundle where 2 | 3 | import qualified Data.Text as T 4 | import Lucid 5 | import RIO 6 | import Types 7 | 8 | data Bundle 9 | = HomeBundle 10 | | TalkBundle 11 | | SearchBundle 12 | 13 | instance Show Bundle where 14 | show = \case 15 | HomeBundle -> "Home" 16 | TalkBundle -> "Talk" 17 | SearchBundle -> "Search" 18 | 19 | includeBundle :: Bundle -> AppM (Html ()) 20 | includeBundle bundle = do 21 | Config { devMode, lookupStatic } <- ask 22 | let 23 | prefix = if devMode then "http://localhost:7000/" else "/dist/" 24 | [commonJs, commonCss, bundleJs, bundleCss] = (prefix <>) <$> if devMode 25 | then 26 | ["common.js", "", show bundle <> ".js", ""] 27 | else 28 | [ lookupStatic $ "common" <> ".js" 29 | , lookupStatic $ "common" <> ".css" 30 | , lookupStatic $ show bundle <> ".js" 31 | , lookupStatic $ show bundle <> ".css" 32 | ] 33 | pure $ do 34 | when (not devMode) $ do 35 | link_ [ href_ $ T.pack commonCss, rel_ "stylesheet" ] 36 | link_ [ href_ $ T.pack bundleCss, rel_ "stylesheet" ] 37 | script_ [ src_ $ T.pack commonJs ] ("" :: Text) 38 | script_ [ src_ $ T.pack bundleJs ] ("" :: Text) 39 | -------------------------------------------------------------------------------- /backend/src/View/Error.hs: -------------------------------------------------------------------------------- 1 | module View.Error where 2 | 3 | import Lucid 4 | import RIO 5 | import Servant (ServantErr (..), err404, throwError) 6 | import Types 7 | 8 | get404H :: AppM (Html ()) 9 | get404H = do 10 | throwError err404 { errBody = renderBS page } 11 | -- liftIO $ throwError err404 { errBody = renderBS page } 12 | -- pure page 13 | where 14 | page = doctypehtml_ $ do 15 | head_ $ do 16 | meta_ [charset_ "utf-8"] 17 | meta_ [name_ "viewport" 18 | ,content_ "width=device-width, initial-scale=1"] 19 | body_ $ do 20 | div_ "I'm lost. The page you're looking for is not here." 21 | -------------------------------------------------------------------------------- /backend/src/View/Home.hs: -------------------------------------------------------------------------------- 1 | module View.Home where 2 | 3 | import Data.Aeson.Text (encodeToLazyText) 4 | import qualified Data.Text.Lazy as LT 5 | import Lucid 6 | import Lucid.Base (makeAttribute) 7 | import Models.Talk (getTalks) 8 | import RIO 9 | import Types 10 | import View.Bundle 11 | import View.Layout (layout) 12 | 13 | getHomeH :: AppM (Html ()) 14 | getHomeH = do 15 | talks <- lift $ getTalks 0 20 16 | bundle <- includeBundle HomeBundle 17 | layout 18 | ( do 19 | title_ "TED2srt: Download bilingual subtitles of TED talks" 20 | meta_ 21 | [ makeAttribute "property" "og:description" 22 | , name_ "description" 23 | , content_ "Download bilingual subtitles and transcripts of TED talks. TED演讲双语字幕下载。" 24 | ] 25 | meta_ 26 | [ makeAttribute "property" "og:url" 27 | , content_ "https://ted2srt.org" 28 | ] 29 | meta_ 30 | [ makeAttribute "property" "og:title" 31 | , content_ "TED2srt: Download bilingual subtitles of TED talks" 32 | ] 33 | meta_ 34 | [ makeAttribute "property" "og:type" 35 | , content_ "website" 36 | ] 37 | meta_ 38 | [ makeAttribute "property" "og:image" 39 | , content_ "https://ted2srt.org/dist/icon.png" 40 | ] 41 | script_ $ LT.toStrict $ 42 | "window.TALKS = " <> encodeToLazyText talks 43 | ) 44 | bundle 45 | -------------------------------------------------------------------------------- /backend/src/View/Layout.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE QuasiQuotes #-} 2 | 3 | module View.Layout where 4 | 5 | import Lucid 6 | import RIO 7 | import Text.RawString.QQ 8 | import Types 9 | 10 | layout :: Html () -> Html () -> AppM (Html ()) 11 | layout headPartial bodyPartial = do 12 | Config { devMode } <- ask 13 | pure $ doctype_ *> (html_ [lang_ "en"] $ do 14 | head_ $ do 15 | meta_ [charset_ "utf-8"] 16 | meta_ [name_ "viewport" 17 | ,content_ "width=device-width, initial-scale=1"] 18 | link_ [title_ "TED2srt" 19 | ,href_ "/dist/search.xml" 20 | ,type_ "application/opensearchdescription+xml" 21 | ,rel_"search"] 22 | headPartial 23 | 24 | body_ $ do 25 | bodyPartial 26 | when (not devMode) $ do 27 | script_ 28 | [type_ "application/ld+json"] ( 29 | [r|{ 30 | "@context": "http://schema.org", 31 | "@type": "WebSite", 32 | "url": "https://ted2srt.org", 33 | "potentialAction": { 34 | "@type": "SearchAction", 35 | "target": "https://ted2srt.org/search?q={search_term_string}", 36 | "query-input": "required name=search_term_string" 37 | } 38 | }|] :: Text) 39 | script_ 40 | [src_ "https://www.googletagmanager.com/gtag/js?id=UA-109501213-1"] 41 | ("" :: Text) 42 | script_ 43 | [r| 44 | window.dataLayer = window.dataLayer || []; 45 | function gtag(){dataLayer.push(arguments);} 46 | gtag('js', new Date()); 47 | 48 | gtag('config', 'UA-109501213-1'); 49 | |] 50 | ) 51 | -------------------------------------------------------------------------------- /backend/src/View/Search.hs: -------------------------------------------------------------------------------- 1 | module View.Search where 2 | 3 | import qualified Data.Text as T 4 | import Lucid 5 | import RIO 6 | import Types 7 | import View.Bundle 8 | import View.Error 9 | import View.Layout (layout) 10 | 11 | getSearchH :: Maybe Text -> AppM (Html ()) 12 | getSearchH mq = 13 | case mq of 14 | Nothing -> get404H 15 | Just q -> do 16 | bundle <- includeBundle SearchBundle 17 | layout 18 | ( do 19 | title_ $ toHtml $ q <> " - TED2srt search" 20 | script_ $ "window.Q = " <> T.pack (show q) 21 | ) 22 | bundle 23 | -------------------------------------------------------------------------------- /backend/src/View/Talk.hs: -------------------------------------------------------------------------------- 1 | module View.Talk where 2 | 3 | import Data.Aeson.Text (encodeToLazyText) 4 | import qualified Data.Text.Lazy as LT 5 | import Database.Persist 6 | import Lucid 7 | import Lucid.Base (makeAttribute) 8 | import Models.Talk (getTalkBySlug) 9 | import RIO 10 | import Types 11 | import View.Bundle 12 | import View.Error 13 | import View.Layout (layout) 14 | 15 | getTalkH :: Text -> AppM (Html ()) 16 | getTalkH slug = do 17 | mTalk <- lift $ getTalkBySlug slug 18 | case mTalk of 19 | Nothing -> get404H 20 | Just entity@(Entity _ talk) -> do 21 | bundle <- includeBundle TalkBundle 22 | layout 23 | ( do 24 | title_ $ toHtml $ talkName talk 25 | meta_ 26 | [ makeAttribute "property" "og:description" 27 | , name_ "description" 28 | , content_ $ talkDescription talk 29 | ] 30 | meta_ 31 | [ makeAttribute "property" "og:url" 32 | , content_ $ "https://ted2srt.org/talks/" <> talkSlug talk 33 | ] 34 | meta_ 35 | [ makeAttribute "property" "og:title" 36 | , content_ $ talkName talk 37 | ] 38 | meta_ 39 | [ makeAttribute "property" "og:type" 40 | , content_ "article" 41 | ] 42 | meta_ 43 | [ makeAttribute "property" "og:image" 44 | , content_ $ talkImage talk 45 | ] 46 | script_ $ LT.toStrict $ 47 | "window.TALK = " <> encodeToLazyText (entityIdToJSON entity) 48 | ) 49 | bundle 50 | -------------------------------------------------------------------------------- /backend/src/Web/TED.hs: -------------------------------------------------------------------------------- 1 | module Web.TED 2 | ( Subtitle (..) 3 | , FileType (..) 4 | , Item (..) 5 | , toSub 6 | -- * Re-exports 7 | , module TED 8 | ) where 9 | 10 | import Control.Exception as E 11 | import Control.Monad 12 | import Data.Aeson 13 | import Data.Text (Text) 14 | import qualified Data.Text as T 15 | import qualified Data.Text.IO as T 16 | import qualified Data.Text.IO.Utf8 as Utf8 17 | import GHC.Generics (Generic) 18 | import Network.HTTP.Conduit hiding (path) 19 | import RIO 20 | import RIO.List.Partial (head) 21 | import System.Directory 22 | import System.IO (hPutStr, hPutStrLn, openFile, print) 23 | import qualified System.IO.Utf8 as Utf8 24 | import Text.Printf 25 | 26 | import Web.TED.API as TED 27 | import Web.TED.Feed as TED 28 | import Web.TED.TalkPage as TED 29 | 30 | 31 | data Caption = Caption 32 | { captions :: [Item] 33 | } deriving (Generic, Show) 34 | instance FromJSON Caption 35 | 36 | data Item = Item 37 | { duration :: Int 38 | , content :: Text 39 | , startOfParagraph :: Bool 40 | , startTime :: Int 41 | } deriving (Generic, Show) 42 | instance FromJSON Item 43 | 44 | data FileType = SRT | VTT | TXT | LRC 45 | deriving (Show, Eq) 46 | 47 | data Subtitle = Subtitle 48 | { talkId :: Int 49 | , talkslug :: Text 50 | , language :: [Text] 51 | , filename :: Text 52 | , timeLag :: Double 53 | , filetype :: FileType 54 | } deriving Show 55 | 56 | availableLanguages :: [Text] 57 | availableLanguages = 58 | [ "af", "sq", "arq", "am", "ar", "hy", "as", "ast", "az", "eu", "be", "bn" 59 | , "bi", "bs", "bg", "my", "ca", "ceb", "zh-cn", "zh-tw", "zh", "ht", "hr" 60 | , "cs", "da", "nl", "en", "eo", "et", "fil", "fi", "fr", "fr-ca", "gl" 61 | , "ka", "de", "el", "gu", "ha", "he", "hi", "hu", "hup", "is", "id", "inh" 62 | , "ga", "it", "ja", "kn", "kk", "km", "tlh", "ko", "ku", "ky", "lo", "ltg" 63 | , "la", "lv", "lt", "lb", "rup", "mk", "mg", "ms", "ml", "mt", "mr", "mn" 64 | , "srp", "ne", "nb", "nn", "oc", "fa", "pl", "pt", "pt-br", "ro", "ru" 65 | , "sr", "sh", "szl", "si", "sk", "sl", "so", "es", "sw", "sv", "tl", "tg" 66 | , "ta", "tt", "te", "th", "bo", "tr", "uk", "ur", "ug", "uz", "vi" 67 | ] 68 | 69 | toSub :: Subtitle -> IO (Maybe FilePath) 70 | toSub sub 71 | | any (`notElem` availableLanguages) lang = return Nothing 72 | | filetype sub == LRC = oneLrc sub 73 | | length lang == 1 = func sub 74 | | otherwise = 75 | case lang of 76 | [s1, s2] -> do 77 | pwd <- getCurrentDirectory 78 | let 79 | path = T.unpack $ T.concat [ T.pack pwd 80 | , dir 81 | , filename sub 82 | , "." 83 | , s1 84 | , "." 85 | , s2 86 | , suffix 87 | ] 88 | cached <- doesFileExist path 89 | if cached 90 | then return $ Just path 91 | else do 92 | p1 <- func sub { language = [s1] } 93 | p2 <- func sub { language = [s2] } 94 | case (p1, p2) of 95 | (Just p1', Just p2') -> do 96 | mergeFile p1' p2' path 97 | return $ Just path 98 | _ -> return Nothing 99 | _ -> return Nothing 100 | where 101 | lang = language sub 102 | (dir, suffix, func) = case filetype sub of 103 | SRT -> ("/static/srt/", ".srt", oneSub) 104 | VTT -> ("/static/vtt/", ".vtt", oneSub) 105 | TXT -> ("/static/txt/", ".txt", oneTxt) 106 | LRC -> ("/static/lrc/", ".lrc", oneLrc) 107 | 108 | oneSub :: Subtitle -> IO (Maybe FilePath) 109 | oneSub sub = do 110 | path <- subtitlePath sub 111 | cached <- doesFileExist path 112 | if cached 113 | then return $ Just path 114 | else do 115 | let rurl = T.unpack $ "https://www.ted.com/talks/subtitles/id/" 116 | <> T.pack (show $ talkId sub) <> "/lang/" <> head (language sub) 117 | E.catch (do 118 | res <- simpleHttp rurl 119 | let decoded = decode res :: Maybe Caption 120 | case decoded of 121 | Just r -> do 122 | h <- if filetype sub == VTT 123 | then do 124 | h <- openFile path WriteMode 125 | hPutStrLn h "WEBVTT\n" 126 | return h 127 | else do 128 | -- Prepend the UTF-8 byte order mark 129 | -- to do Windows user a favor. 130 | withBinaryFile path WriteMode $ \h -> 131 | hPutStr h "\xef\xbb\xbf" 132 | openFile path AppendMode 133 | forM_ (zip (captions r) [1,2..]) (ppr h) 134 | hClose h 135 | return $ Just path 136 | Nothing -> 137 | return Nothing) 138 | (\e -> do print (e :: E.SomeException) 139 | return Nothing) 140 | where 141 | fmt = if filetype sub == SRT 142 | then "%d\n%02d:%02d:%02d,%03d --> " ++ 143 | "%02d:%02d:%02d,%03d\n%s\n\n" 144 | else "%d\n%02d:%02d:%02d.%03d --> " ++ 145 | "%02d:%02d:%02d.%03d\n%s\n\n" 146 | ppr h (c,i) = Utf8.withHandle h $ do 147 | let st = startTime c + floor (timeLag sub) 148 | sh = st `div` 1000 `div` 3600 149 | sm = st `div` 1000 `mod` 3600 `div` 60 150 | ss = st `div` 1000 `mod` 60 151 | sms = st `mod` 1000 152 | et = st + duration c 153 | eh = et `div` 1000 `div` 3600 154 | em = et `div` 1000 `mod` 3600 `div` 60 155 | es = et `div` 1000 `mod` 60 156 | ems = et `mod` 1000 157 | hPrintf h fmt (i::Int) sh sm ss sms eh em es ems 158 | (T.unpack . T.intercalate " " . T.lines $ content c) 159 | 160 | oneTxt :: Subtitle -> IO (Maybe FilePath) 161 | oneTxt sub = do 162 | print sub 163 | path <- subtitlePath sub 164 | cached <- doesFileExist path 165 | if cached 166 | then return $ Just path 167 | else do 168 | E.handle (\(_ :: SomeException) -> pure Nothing) $ do 169 | txt <- TED.getTalkTranscript (talkId sub) (head $ language sub) 170 | -- Prepend the UTF-8 byte order mark to do Windows user a favor. 171 | withBinaryFile path WriteMode $ \h -> Utf8.withHandle h $ 172 | hPutStr h "\xef\xbb\xbf" 173 | Utf8.withFile path AppendMode $ \h -> 174 | T.hPutStrLn h txt 175 | return $ Just path 176 | 177 | oneLrc :: Subtitle -> IO (Maybe FilePath) 178 | oneLrc sub = do 179 | path <- subtitlePath sub 180 | cached <- doesFileExist path 181 | if cached 182 | then return $ Just path 183 | else do 184 | let rurl = T.unpack $ "http://www.ted.com/talks/subtitles/id/" 185 | <> T.pack (show $ talkId sub) <> "/lang/en" 186 | E.catch (do 187 | res <- simpleHttp rurl 188 | let decoded = decode res :: Maybe Caption 189 | case decoded of 190 | Just r -> do 191 | h <- openFile path WriteMode 192 | forM_ (captions r) (ppr h) 193 | hClose h 194 | return $ Just path 195 | Nothing -> 196 | return Nothing) 197 | (\e -> do print (e :: E.SomeException) 198 | return Nothing) 199 | where 200 | fmt = "[%02d:%02d.%02d]%s\n" 201 | ppr h c = do 202 | let st = startTime c + floor (timeLag sub) + 3000 203 | sm = st `div` 1000 `mod` 3600 `div` 60 204 | ss = st `div` 1000 `mod` 60 205 | sms = st `mod` 100 206 | hPrintf h fmt sm ss sms (T.unpack $ content c) 207 | 208 | mergeFile :: FilePath -> FilePath -> FilePath -> IO () 209 | mergeFile p1 p2 path = do 210 | c1 <- Utf8.readFile p1 211 | c2 <- Utf8.readFile p2 212 | let merged = T.unlines $ merge (T.lines c1) (T.lines c2) 213 | Utf8.writeFile path merged 214 | 215 | -- | Merge srt files of two language line by line. However, 216 | -- one line in srt_1 may correspond to two lines in srt_2, or vice versa. 217 | merge :: [Text] -> [Text] -> [Text] 218 | merge (a:as) (b:bs) 219 | | a == b = a : merge as bs 220 | | a == "" = b : merge (a:as) bs 221 | | b == "" = a : merge as (b:bs) 222 | | otherwise = a : b : merge as bs 223 | merge _ _ = [] 224 | 225 | -- Construct file path according to filetype. 226 | subtitlePath :: Subtitle -> IO FilePath 227 | subtitlePath sub = do 228 | case language sub of 229 | [ lang ] -> do 230 | case filetype sub of 231 | SRT -> path lang ("/static/srt/", ".srt") 232 | VTT -> path lang ("/static/vtt/", ".vtt") 233 | TXT -> path lang ("/static/txt/", ".txt") 234 | LRC -> pathEn ("/static/lrc/", ".lrc") 235 | _ -> error "subtitlePath only works on one lang" 236 | where 237 | path lang = if lang == "en" then pathEn else pathTr lang 238 | pathTr lang (dir, suffix) = do 239 | pwd <- getCurrentDirectory 240 | return $ T.unpack $ T.concat [ T.pack pwd 241 | , dir 242 | , filename sub 243 | , "." 244 | , lang 245 | , suffix 246 | ] 247 | pathEn (dir, suffix) = do 248 | pwd <- getCurrentDirectory 249 | return $ T.unpack $ T.concat [ T.pack pwd 250 | , dir 251 | , filename sub 252 | , suffix 253 | ] 254 | -------------------------------------------------------------------------------- /backend/src/Web/TED/API.hs: -------------------------------------------------------------------------------- 1 | -- | TED API module 2 | -- Documented at 3 | 4 | module Web.TED.API 5 | ( getTalkTranscript 6 | ) where 7 | 8 | import Data.Aeson (eitherDecode) 9 | import Data.Text (Text) 10 | import qualified Data.Text as T 11 | import Network.HTTP.Conduit (simpleHttp) 12 | import RIO 13 | 14 | import Web.TED.Types 15 | 16 | 17 | getTalkTranscript :: Int -> Text -> IO Text 18 | getTalkTranscript talkId language = do 19 | res <- simpleHttp rurl 20 | case eitherDecode res of 21 | Right r -> return $ transcriptToText r 22 | Left er -> error er 23 | where 24 | rurl = "https://www.ted.com/talks/" <> show talkId <> "/transcript.json?language=" <> T.unpack language 25 | -------------------------------------------------------------------------------- /backend/src/Web/TED/Feed.hs: -------------------------------------------------------------------------------- 1 | -- Mostly taken from yesod-newsfeed 2 | -- https://hackage.haskell.org/package/yesod-newsfeed 3 | 4 | module Web.TED.Feed 5 | ( Feed (..) 6 | , FeedEntry (..) 7 | , template 8 | ) where 9 | 10 | import qualified Data.Map as Map 11 | import Data.Text (Text) 12 | import qualified Data.Text as T 13 | import Data.Time (UTCTime, defaultTimeLocale, formatTime) 14 | import RIO 15 | import Text.XML 16 | 17 | 18 | data Feed = Feed 19 | { feedTitle :: Text 20 | , feedLinkSelf :: Text 21 | , feedLinkHome :: Text 22 | , feedAuthor :: Text 23 | , feedUpdated :: UTCTime 24 | , feedEntries :: [FeedEntry] 25 | } 26 | 27 | data FeedEntry = FeedEntry 28 | { feedEntryTitle :: Text 29 | , feedEntryLink :: Text 30 | , feedEntryUpdated :: UTCTime 31 | , feedEntryContent :: Text 32 | } 33 | 34 | -- | Format a 'UTCTime' in W3 format. 35 | formatW3 :: UTCTime -> T.Text 36 | formatW3 = T.pack . formatTime defaultTimeLocale "%FT%X-00:00" 37 | 38 | template :: Feed -> Document 39 | template Feed {..} = 40 | Document (Prologue [] Nothing []) (addNS root) [] 41 | where 42 | addNS (Element (Name ln _ _) as ns) = Element (Name ln (Just namespace) Nothing) as (map addNS' ns) 43 | addNS' (NodeElement e) = NodeElement $ addNS e 44 | addNS' n = n 45 | namespace = "http://www.w3.org/2005/Atom" 46 | 47 | root = Element "feed" Map.empty $ map NodeElement 48 | $ Element "title" Map.empty [NodeContent feedTitle] 49 | : Element "link" (Map.fromList [("rel", "self"), ("href", feedLinkSelf)]) [] 50 | : Element "link" (Map.singleton "href" feedLinkHome) [] 51 | : Element "updated" Map.empty [NodeContent $ formatW3 feedUpdated] 52 | : Element "id" Map.empty [NodeContent feedLinkHome] 53 | : Element "author" Map.empty [NodeElement $ Element "name" Map.empty [NodeContent feedAuthor]] 54 | : map entryTemplate feedEntries 55 | 56 | entryTemplate :: FeedEntry -> Element 57 | entryTemplate FeedEntry {..} = Element "entry" Map.empty $ map NodeElement 58 | [ Element "id" Map.empty [NodeContent feedEntryLink] 59 | , Element "link" (Map.singleton "href" feedEntryLink) [] 60 | , Element "updated" Map.empty [NodeContent $ formatW3 feedEntryUpdated] 61 | , Element "title" Map.empty [NodeContent feedEntryTitle] 62 | , Element "content" (Map.singleton "type" "html") [NodeContent feedEntryContent] 63 | ] 64 | -------------------------------------------------------------------------------- /backend/src/Web/TED/TalkPage.hs: -------------------------------------------------------------------------------- 1 | -- | TED talk page module 2 | -- Parse the TED talk page to retrieve information 3 | 4 | {-# LANGUAGE OverloadedStrings #-} 5 | module Web.TED.TalkPage 6 | ( getTalkId 7 | , getSlugAndPad 8 | , parseDescription 9 | , parseImage 10 | , parseMediaPad 11 | , parseMediaSlug 12 | , parseTalkObject 13 | ) where 14 | 15 | import Control.Exception as E 16 | import Control.Monad 17 | import Data.ByteString.Lazy (ByteString) 18 | import qualified Data.ByteString.Lazy.Char8 as L8 19 | import Data.Text (Text) 20 | import qualified Data.Text as T 21 | import Network.HTTP.Conduit 22 | import Prelude hiding (id) 23 | import Text.Regex.Posix ((=~)) 24 | import Text.XML.Cursor 25 | 26 | 27 | -- | Given talk url, return talk id. 28 | getTalkId :: Text -> IO (Maybe Int) 29 | getTalkId uri = E.catch 30 | (do body <- simpleHttp $ T.unpack uri 31 | return $ Just $ parseId body) 32 | (\e -> do print (e :: E.SomeException) 33 | return Nothing) 34 | 35 | parseId :: ByteString -> Int 36 | parseId body = read $ L8.unpack $ last $ last r 37 | where 38 | pat = "id\":\"([^,]+)\",\"mediaIdentifier" :: ByteString 39 | r = body =~ pat :: [[ByteString]] 40 | 41 | parseDescription :: Cursor -> Text 42 | parseDescription cursor = head $ head $ 43 | cursor $// element "meta" &.// attributeIs "name" "description" 44 | &| attribute "content" 45 | 46 | parseImage :: Cursor -> Text 47 | parseImage cursor = head $ head $ 48 | cursor $// element "meta" &.// attributeIs "property" "og:image:secure_url" 49 | &| attribute "content" 50 | 51 | parseTalkObject :: ByteString -> ByteString 52 | parseTalkObject body = last $ last r 53 | where 54 | pat = "player_talks\":\\[(.+)\\],\"recorded_at" :: ByteString 55 | r = body =~ pat :: [[ByteString]] 56 | 57 | -- | Given talk url, return mediaSlug and mediaPad of talk. 58 | getSlugAndPad :: Text -> IO (Text, Double) 59 | getSlugAndPad rurl = E.catch 60 | (do body <- simpleHttp $ T.unpack rurl 61 | return (parseMediaSlug body, parseMediaPad body) 62 | ) 63 | (\e -> error $ show (e :: E.SomeException)) 64 | 65 | -- File name slug when saved to local. 66 | parseMediaSlug :: ByteString -> Text 67 | parseMediaSlug body = T.pack $ L8.unpack $ last $ last r 68 | where 69 | pat = "\"low\":\"https://download.ted.com/talks/(.+)-light.mp4\\?apikey=" :: ByteString 70 | r = body =~ pat :: [[ByteString]] 71 | 72 | -- TED talk videos begin with different versions of TED promos. 73 | -- To keep sync, add time delay (in milliseconds) to subtitles. 74 | parseMediaPad :: ByteString -> Double 75 | parseMediaPad body = read t * 1000.0 76 | where 77 | pat = "introDuration\":([^,]+)" :: ByteString 78 | r = body =~ pat :: [[ByteString]] 79 | t = L8.unpack $ last $ last r 80 | -------------------------------------------------------------------------------- /backend/src/Web/TED/Types.hs: -------------------------------------------------------------------------------- 1 | module Web.TED.Types 2 | ( Cue(..) 3 | , Paragraph(..) 4 | , Transcript(..) 5 | , transcriptToText 6 | ) where 7 | 8 | 9 | import Data.Aeson 10 | import Data.Text (Text) 11 | import qualified Data.Text as T 12 | import RIO 13 | 14 | data Cue = Cue 15 | { time :: Int 16 | , text :: Text 17 | } deriving (Generic, Show) 18 | instance FromJSON Cue 19 | 20 | data Paragraph = Paragraph 21 | { cues :: [Cue] 22 | } deriving (Generic, Show) 23 | instance FromJSON Paragraph 24 | 25 | data Transcript = Transcript 26 | { paragraphs :: [Paragraph] 27 | } deriving (Generic, Show) 28 | instance FromJSON Transcript 29 | 30 | transcriptToText :: Transcript -> Text 31 | transcriptToText (Transcript ps) = 32 | T.intercalate "\n" $ map ( 33 | \(Paragraph cues) -> T.intercalate " " $ map (T.replace "\n" " " . text) cues) ps 34 | -------------------------------------------------------------------------------- /backend/src/docs.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE FlexibleInstances #-} 3 | {-# LANGUAGE MultiParamTypeClasses #-} 4 | {-# LANGUAGE OverloadedStrings #-} 5 | import Data.Text (Text) 6 | import Data.Time (buildTime, defaultTimeLocale) 7 | import Servant (Capture, QueryParam, QueryParams) 8 | import Servant.Docs 9 | 10 | import Web.TED (FileType) 11 | import qualified Web.TED as API 12 | import Handler.Util 13 | import ReTed.API (tedApi) 14 | 15 | instance ToSample [Char] [Char] where 16 | toSample _ = Just "abc" 17 | 18 | instance ToSample Text Text where 19 | toSample _ = Just "abc" 20 | 21 | instance ToSample RedisTalk RedisTalk where 22 | toSample _ = Just $ 23 | RedisTalk { Handler.Util.id = 1 24 | , name = "1" 25 | , description = "1" 26 | , slug = "1" 27 | , images = API.Image "1" "1" 28 | , publishedAt = buildTime defaultTimeLocale [('0', "0")] 29 | , mSlug = "1" 30 | , mPad = 1 31 | } 32 | instance ToSample [RedisTalk] [RedisTalk] where 33 | toSample _ = Just $ 34 | [RedisTalk { Handler.Util.id = 1 35 | , name = "1" 36 | , description = "1" 37 | , slug = "1" 38 | , images = API.Image "1" "1" 39 | , publishedAt = buildTime defaultTimeLocale [('0', "0")] 40 | , mSlug = "1" 41 | , mPad = 1 42 | }] 43 | 44 | instance ToSample TalkResp TalkResp where 45 | toSample _ = Just $ 46 | TalkResp 47 | (RedisTalk { Handler.Util.id = 1 48 | , name = "1" 49 | , description = "1" 50 | , slug = "1" 51 | , images = API.Image "1" "1" 52 | , publishedAt = buildTime defaultTimeLocale [('0', "0")] 53 | , mSlug = "1" 54 | , mPad = 1 55 | }) $ Just [(API.Language "English" "en")] 56 | 57 | instance ToParam (QueryParam "limit" Integer) where 58 | toParam _ = 59 | DocQueryParam "limit" 60 | ["5", "10"] 61 | "maximum number of return items" 62 | Normal 63 | 64 | instance ToParam (QueryParam "tid" Integer) where 65 | toParam _ = 66 | DocQueryParam "tid" 67 | ["1194", "2015"] 68 | "TED talk id" 69 | Normal 70 | 71 | instance ToCapture (Capture "tid" Int) where 72 | toCapture _ = 73 | DocCapture "tid" "TED talk id" 74 | 75 | instance ToCapture (Capture "slug" Text) where 76 | toCapture _ = 77 | DocCapture "slug" "slug in talk url" 78 | 79 | instance ToCapture (Capture "format" FileType) where 80 | toCapture _ = 81 | DocCapture "format" "format of transcripts" 82 | 83 | instance ToParam (QueryParams "lang" Text) where 84 | toParam _ = 85 | DocQueryParam "lang" 86 | ["en", "zh-cn"] 87 | "language code" 88 | List 89 | 90 | instance ToParam (QueryParam "q" Text) where 91 | toParam _ = 92 | DocQueryParam "q" 93 | ["google", "design"] 94 | "keywords to search" 95 | Normal 96 | 97 | reTedDocs :: API 98 | reTedDocs = docs tedApi 99 | 100 | main :: IO () 101 | main = putStrLn $ markdown reTedDocs 102 | -------------------------------------------------------------------------------- /backend/stack.yaml: -------------------------------------------------------------------------------- 1 | # This file was automatically generated by 'stack init' 2 | # 3 | # Some commonly used options have been documented as comments in this file. 4 | # For advanced use and comprehensive documentation of the format, please see: 5 | # http://docs.haskellstack.org/en/stable/yaml_configuration/ 6 | 7 | # Resolver to choose a 'specific' stackage snapshot or a compiler version. 8 | # A snapshot resolver dictates the compiler version and the set of packages 9 | # to be used for project dependencies. For example: 10 | # 11 | # resolver: lts-3.5 12 | # resolver: nightly-2015-09-21 13 | # resolver: ghc-7.10.2 14 | # resolver: ghcjs-0.1.0_ghc-7.10.2 15 | # resolver: 16 | # name: custom-snapshot 17 | # location: "./custom-snapshot.yaml" 18 | resolver: lts-13.19 19 | 20 | # User packages to be built. 21 | # Various formats can be used as shown in the example below. 22 | # 23 | # packages: 24 | # - some-directory 25 | # - https://example.com/foo/bar/baz-0.0.2.tar.gz 26 | # - location: 27 | # git: https://github.com/commercialhaskell/stack.git 28 | # commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a 29 | # - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a 30 | # extra-dep: true 31 | # subdirs: 32 | # - auto-update 33 | # - wai 34 | # 35 | # A package marked 'extra-dep: true' will only be built if demanded by a 36 | # non-dependency (i.e. a user package), and its test suites and benchmarks 37 | # will not be run. This is useful for tweaking upstream packages. 38 | packages: 39 | - '.' 40 | # Dependency packages to be pulled from upstream that are not in the resolver 41 | # (e.g., acme-missiles-0.3) 42 | extra-deps: 43 | - hedis-0.12.9 44 | - with-utf8-1.0.0.0 45 | 46 | # Override default flag values for local packages and extra-deps 47 | flags: {} 48 | 49 | # Extra package databases containing global packages 50 | extra-package-dbs: [] 51 | 52 | # Control whether we use the GHC we find on the path 53 | # system-ghc: true 54 | # 55 | # Require a specific version of stack, using version ranges 56 | # require-stack-version: -any # Default 57 | # require-stack-version: ">=1.1" 58 | # 59 | # Override the architecture used by stack, especially useful on Windows 60 | # arch: i386 61 | # arch: x86_64 62 | # 63 | # Extra directories used by stack for building 64 | # extra-include-dirs: [/path/to/dir] 65 | # extra-lib-dirs: [/path/to/dir] 66 | # 67 | # Allow a newer minor version of GHC than the snapshot specifies 68 | # compiler-check: newer-minor 69 | 70 | nix: 71 | enable: true 72 | shell-file: default.nix 73 | -------------------------------------------------------------------------------- /backend/static/.gitkeep: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rnons/ted2srt/7456f109bce2b9f07d0c929bef2fd42e6bc4f75d/backend/static/.gitkeep -------------------------------------------------------------------------------- /backend/static/img/tweak.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rnons/ted2srt/7456f109bce2b9f07d0c929bef2fd42e6bc4f75d/backend/static/img/tweak.jpg -------------------------------------------------------------------------------- /backend/static/lrc/.gitkeep: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rnons/ted2srt/7456f109bce2b9f07d0c929bef2fd42e6bc4f75d/backend/static/lrc/.gitkeep -------------------------------------------------------------------------------- /backend/static/srt/.gitkeep: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rnons/ted2srt/7456f109bce2b9f07d0c929bef2fd42e6bc4f75d/backend/static/srt/.gitkeep -------------------------------------------------------------------------------- /backend/static/txt/.gitkeep: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rnons/ted2srt/7456f109bce2b9f07d0c929bef2fd42e6bc4f75d/backend/static/txt/.gitkeep -------------------------------------------------------------------------------- /backend/static/vtt/.gitkeep: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rnons/ted2srt/7456f109bce2b9f07d0c929bef2fd42e6bc4f75d/backend/static/vtt/.gitkeep -------------------------------------------------------------------------------- /backend/ted2srt.nix: -------------------------------------------------------------------------------- 1 | { mkDerivation, aeson, base, base64-bytestring, bytestring, conduit 2 | , conduit-extra, containers, cryptonite, cryptonite-conduit 3 | , directory, either, hedis, hpack, html-conduit, http-conduit 4 | , http-types, load-env, lucid, memory, monad-logger, mtl, network 5 | , persistent, persistent-postgresql, persistent-template 6 | , raw-strings-qq, regex-posix, rio, servant-lucid, servant-server 7 | , stdenv, system-filepath, text, time, transformers 8 | , unordered-containers, vector, wai, wai-extra, warp, with-utf8 9 | , xml-conduit 10 | , postgresql_11}: 11 | mkDerivation { 12 | pname = "ted2srt"; 13 | version = "3.20200412"; 14 | src = ./.; 15 | isLibrary = true; 16 | isExecutable = true; 17 | libraryHaskellDepends = [ 18 | aeson base base64-bytestring bytestring conduit conduit-extra 19 | containers cryptonite cryptonite-conduit directory either hedis 20 | html-conduit http-conduit http-types load-env lucid memory 21 | monad-logger mtl network persistent persistent-postgresql 22 | persistent-template raw-strings-qq regex-posix rio servant-lucid 23 | servant-server system-filepath text time transformers 24 | unordered-containers vector wai with-utf8 xml-conduit 25 | ]; 26 | librarySystemDepends = [ postgresql_11 ]; 27 | libraryToolDepends = [ hpack ]; 28 | executableHaskellDepends = [ 29 | aeson base base64-bytestring bytestring conduit conduit-extra 30 | containers cryptonite cryptonite-conduit directory either hedis 31 | html-conduit http-conduit http-types load-env lucid memory 32 | monad-logger mtl network persistent persistent-postgresql 33 | persistent-template raw-strings-qq regex-posix rio servant-lucid 34 | servant-server system-filepath text time transformers 35 | unordered-containers vector wai wai-extra warp with-utf8 36 | xml-conduit 37 | ]; 38 | doHaddock = false; 39 | prePatch = "hpack"; 40 | license = "unknown"; 41 | hydraPlatforms = stdenv.lib.platforms.none; 42 | } 43 | -------------------------------------------------------------------------------- /backend/test/Main.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import LoadEnv (loadEnvFrom) 4 | import System.Exit (ExitCode(..)) 5 | import System.Process (system) 6 | import Test.Hspec.Runner 7 | import Test.Hspec.Formatters 8 | 9 | import qualified Spec 10 | 11 | 12 | main :: IO () 13 | main = do 14 | loadEnvFrom ".env.test" 15 | ExitSuccess <- system "test/before.sh" 16 | hspecWith defaultConfig {configFormatter = Just progress} Spec.spec 17 | return () 18 | -------------------------------------------------------------------------------- /backend/test/ReTed/ApiSpec.hs: -------------------------------------------------------------------------------- 1 | module ReTed.ApiSpec where 2 | 3 | import Data.Aeson (Value, decode) 4 | import Network.Wai (Application) 5 | import Network.Wai.Test (SResponse(..)) 6 | import Servant (serve) 7 | import Test.Hspec 8 | import Test.Hspec.Wai 9 | 10 | import ReTed.API 11 | import ReTed.Config (Config, getConfig) 12 | import ReTed.TestUtils (resetDb) 13 | import ReTed.Models.Talk (Talk) 14 | 15 | 16 | app :: IO Application 17 | app = (serve tedApi . tedServer) <$> getConfig 18 | 19 | spec :: Spec 20 | spec = before resetDb $ with app $ 21 | describe "true" $ do 22 | it "GET /talks should responds with 200" $ 23 | get "/talks" `shouldRespondWith` 200 24 | 25 | it "GET /talks should responds with five talks" $ do 26 | res <- get "/talks" 27 | let v = decode $ simpleBody res :: Maybe [Value] 28 | liftIO $ (length <$> v) `shouldBe` Just 5 29 | -------------------------------------------------------------------------------- /backend/test/ReTed/TestUtils.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE QuasiQuotes #-} 2 | 3 | module ReTed.TestUtils 4 | ( resetDb 5 | ) where 6 | 7 | import RIO 8 | import System.Process (callCommand) 9 | import Text.Printf.TH (s) 10 | 11 | 12 | resetDb :: IO () 13 | resetDb = do 14 | loadFixture "truncate" 15 | loadFixture "data" 16 | 17 | loadFixture :: FilePath -> IO () 18 | loadFixture = loadSql . [s|test/fixtures/%s.sql|] 19 | 20 | loadSql :: FilePath -> IO () 21 | loadSql name = callCommand $ [s|psql -U $DB_USER -d $DB_NAME -f %s|] name 22 | -------------------------------------------------------------------------------- /backend/test/Spec.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -F -pgmF hspec-discover -optF --module-name=Spec #-} 2 | -------------------------------------------------------------------------------- /backend/test/before.sh: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env sh 2 | 3 | psql -U $DB_USER -c "drop database ${DB_NAME};" 4 | psql -U $DB_USER -c "create database ${DB_NAME};" 5 | psql -U $DB_USER -d $DB_NAME -f sql/latest.sql 6 | -------------------------------------------------------------------------------- /backend/test/fixtures/pg_dump.sh: -------------------------------------------------------------------------------- 1 | pg_dump -d ted2srt --data-only --column-inserts -f "./test/fixtures/data.sql" 2 | -------------------------------------------------------------------------------- /backend/test/fixtures/truncate.sql: -------------------------------------------------------------------------------- 1 | TRUNCATE TABLE talks CASCADE; 2 | -------------------------------------------------------------------------------- /backend/tests/ted.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | -- Test cases for Web.TED module 3 | import Data.Maybe (fromJust) 4 | import Data.Text (Text) 5 | import Prelude hiding (id) 6 | import Test.HUnit 7 | import Test.Hspec 8 | 9 | import Web.TED 10 | 11 | main :: IO () 12 | main = do 13 | let uri = "http://www.ted.com/talks/francis_collins_we_need_better_drugs_now.html" 14 | tid <- getTalkId uri 15 | talk <- queryTalk $ fromJust tid 16 | (mediaSlug, pad) <- getSlugAndPad uri 17 | hspec $ spec talk mediaSlug pad 18 | 19 | spec :: Maybe Talk -> Text -> Double -> Spec 20 | spec talk mediaSlug pad = 21 | describe "Ted.hs tests" $ do 22 | it "talk id" $ 23 | fmap id talk @?= Just 1696 24 | it "talk title" $ 25 | fmap name talk @?= Just "Francis Collins: We need better drugs -- now" 26 | 27 | it "available subtitles" $ do 28 | let srtlist = fmap talkLanguages talk 29 | fmap length srtlist @?= Just 26 30 | 31 | it "mediaSlug" $ 32 | mediaSlug @?= "FrancisCollins_2012P" 33 | 34 | it "mediaPad" $ 35 | pad @?= 15330.0 36 | -------------------------------------------------------------------------------- /backend/tests/ted2srt.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | -- Test cases for Foundation.hs 3 | import Database.Redis (connect, defaultConnectInfo) 4 | import Test.Hspec (hspec) 5 | import Yesod.Test 6 | import Foundation 7 | import Settings 8 | 9 | main :: IO () 10 | main = do 11 | s <- staticSite 12 | c <- connect defaultConnectInfo 13 | hspec $ yesodSpec (Ted s c) homeSpecs 14 | 15 | type Specs = YesodSpec Ted 16 | 17 | homeSpecs :: Specs 18 | homeSpecs = 19 | ydescribe "web page tests" $ do 20 | yit "loads the index" $ do 21 | get HomeR 22 | statusIs 200 23 | htmlAllContain "#search_button" "submit" 24 | htmlAllContain "#search_input" "q" 25 | 26 | yit "get talks" $ do 27 | get $ TalksR "ken_robinson_says_schools_kill_creativity.html" 28 | statusIs 200 29 | htmlCount "#main li" 58 30 | htmlCount "#sidepane li" 8 31 | 32 | yit "test search" $ do 33 | get $ SearchR "design" 34 | statusIs 200 35 | 36 | -- 302 is not helpful here 37 | yit "lookup available subtitles" $ do 38 | get (HomeR, [ ("_hasdata", "") 39 | , ("q", "http://www.ted.com/talks/ken_robinson_says_schools_kill_creativity") 40 | ]) 41 | statusIs 302 42 | -------------------------------------------------------------------------------- /frontend/.jshintrc: -------------------------------------------------------------------------------- 1 | { 2 | "browser": true, 3 | "node": true, 4 | "esnext": true, 5 | "bitwise": true, 6 | "camelcase": true, 7 | "eqeqeq": true, 8 | "immed": true, 9 | "indent": 2, 10 | "latedef": true, 11 | "newcap": true, 12 | "noarg": true, 13 | "quotmark": "single", 14 | "undef": true, 15 | "unused": true 16 | } 17 | -------------------------------------------------------------------------------- /frontend/deploy.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | cd frontend && yarn build && cd .. 3 | tar czf dist.tar.gz backend/dist 4 | scp dist.tar.gz ted2srt:/tmp/ 5 | ssh ted2srt /bin/sh <<'ENDSSH' 6 | cd /tmp 7 | tar xf dist.tar.gz 8 | rsync -a --delete backend/dist/ /var/www/ted2srt/dist 9 | ENDSSH 10 | rm dist.tar.gz 11 | -------------------------------------------------------------------------------- /frontend/package.json: -------------------------------------------------------------------------------- 1 | { 2 | "private": true, 3 | "scripts": { 4 | "build": "./scripts/build.sh", 5 | "pscid:build": "spago build", 6 | "start": "webpack-dev-server --progress --port 7000" 7 | }, 8 | "devDependencies": { 9 | "css-loader": "^0.28.11", 10 | "extract-text-webpack-plugin": "^4.0.0-beta.0", 11 | "postcss-import": "^11.1.0", 12 | "postcss-loader": "^2.1.5", 13 | "style-loader": "^0.21.0", 14 | "ts-loader": "^4.4.2", 15 | "typescript": "^2.9.2", 16 | "webpack": "^4.14.0", 17 | "webpack-cli": "^3.0.8", 18 | "webpack-dev-server": "^3.1.4" 19 | }, 20 | "dependencies": { 21 | "tailwindcss": "^0.6.1" 22 | } 23 | } 24 | -------------------------------------------------------------------------------- /frontend/packages.dhall: -------------------------------------------------------------------------------- 1 | let upstream = 2 | https://github.com/purescript/package-sets/releases/download/psc-0.13.6-20200404/packages.dhall sha256:f239f2e215d0cbd5c203307701748581938f74c4c78f4aeffa32c11c131ef7b6 3 | 4 | let nonbili = 5 | https://raw.githubusercontent.com/nonbili/package-sets/d56927bf7d0378647d8302d1bfac30698c208ab9/packages.dhall sha256:4ead482f4ed450dac36166109f54299eeabbac5b30f7e95b9d21d994a84fb5cf 6 | 7 | let overrides = {=} 8 | 9 | let additions = {=} 10 | 11 | in upstream // nonbili // overrides // additions 12 | -------------------------------------------------------------------------------- /frontend/postcss.config.js: -------------------------------------------------------------------------------- 1 | module.exports = { 2 | plugins: [ 3 | require("postcss-import")(), 4 | require("tailwindcss")("./tailwind.js") 5 | ] 6 | }; 7 | -------------------------------------------------------------------------------- /frontend/scripts/build.sh: -------------------------------------------------------------------------------- 1 | set -e 2 | 3 | rm -rf ../backend/dist/*.{css,js} 4 | 5 | spago build -u "-g corefn +RTS -N2 -RTS" 6 | 7 | zephyr -f Home.main Talk.main Search.main +RTS -N2 -RTS 8 | 9 | NODE_ENV=production webpack -p --progress 10 | -------------------------------------------------------------------------------- /frontend/shell.nix: -------------------------------------------------------------------------------- 1 | { pkgs ? import ../nix/nixpkgs.nix {} 2 | , nonbili ? import (fetchTarball https://github.com/nonbili/nonbili-nix-deps/archive/4fc735c10a8eee4a5d044164621651b89d0d6782.tar.gz) { inherit pkgs; } 3 | }: 4 | 5 | pkgs.mkShell { 6 | buildInputs = [ 7 | nonbili.purs 8 | nonbili.spago 9 | nonbili.zephyr 10 | ]; 11 | } 12 | -------------------------------------------------------------------------------- /frontend/spago.dhall: -------------------------------------------------------------------------------- 1 | { name = "ted2srt" 2 | , dependencies = [ "affjax", "argonaut-codecs", "debug", "halogen" ] 3 | , packages = ./packages.dhall 4 | , sources = [ "src/**/*.purs" ] 5 | } 6 | -------------------------------------------------------------------------------- /frontend/src/Component/Footer.purs: -------------------------------------------------------------------------------- 1 | module Component.Footer 2 | ( render 3 | ) where 4 | 5 | import Core.Prelude 6 | 7 | import Halogen.HTML as HH 8 | import Halogen.HTML.Properties as HP 9 | 10 | type Link = 11 | { text :: String 12 | , href :: String 13 | } 14 | 15 | mkLink :: String -> String -> Link 16 | mkLink = { text: _, href: _ } 17 | 18 | itemCls :: String 19 | itemCls = "" 20 | 21 | renderSeparator :: forall p i. HH.HTML p i 22 | renderSeparator = 23 | HH.li 24 | [ class_ "border-l h-4 mx-2"] 25 | [] 26 | 27 | renderLink :: forall p i. Link -> HH.HTML p i 28 | renderLink link = 29 | HH.li 30 | [ class_ itemCls ] 31 | [ HH.a 32 | [ class_ "Link" 33 | , HP.href link.href 34 | ] 35 | [ HH.text link.text ] 36 | ] 37 | 38 | render :: forall p i. HH.HTML p i 39 | render = 40 | HH.div 41 | [ class_ "mt-6 py-4 border-t border-grey300"] 42 | [ HH.ul 43 | [ class_ "container flex items-center justify-center"] 44 | [ HH.li [ class_ "mr-1"] 45 | [ HH.text "TED2srt by" ] 46 | , renderLink $ mkLink "rnons" "https://twitter.com/rnons" 47 | , renderSeparator 48 | , renderLink $ mkLink "source code" "https://github.com/rnons/ted2srt" 49 | , renderSeparator 50 | , renderLink $ mkLink "feed" "/atom.xml" 51 | , renderSeparator 52 | , renderLink $ mkLink "donate" "https://liberapay.com/rnons/" 53 | ] 54 | ] 55 | -------------------------------------------------------------------------------- /frontend/src/Component/Header.purs: -------------------------------------------------------------------------------- 1 | module Component.Header 2 | ( Message(..) 3 | , Query 4 | , Action 5 | , component 6 | ) where 7 | 8 | import Core.Prelude 9 | 10 | import Data.Const (Const) 11 | import Data.String as String 12 | import Effect.Aff (Aff) 13 | import Halogen as H 14 | import Halogen.HTML as HH 15 | import Halogen.HTML.Events as HE 16 | import Halogen.HTML.Properties as HP 17 | import Web.Event.Event as Event 18 | import Web.HTML as Web 19 | import Web.HTML.Location as Location 20 | import Web.HTML.Window as Window 21 | 22 | type Message = Void 23 | 24 | type Query = Const Void 25 | 26 | data Action 27 | = OnSubmit Event.Event 28 | | OnValueInput String 29 | 30 | type HTML = H.ComponentHTML Action () Aff 31 | 32 | type DSL = H.HalogenM State Action () Message Aff 33 | 34 | type State = 35 | { value :: String 36 | } 37 | 38 | initialState :: String -> State 39 | initialState value = 40 | { value 41 | } 42 | 43 | renderForm :: State -> HTML 44 | renderForm state = 45 | HH.form 46 | [ class_ "flex-1 ml-4 lg:ml-8" 47 | , HP.action "/search" 48 | , HE.onSubmit $ Just <<< OnSubmit 49 | ] 50 | [ HH.input 51 | [ class_ "border w-full py-2 px-2 focus:border-red500 outline-none" 52 | , HP.type_ HP.InputSearch 53 | , HP.value state.value 54 | , HP.name "q" 55 | , HP.placeholder "TED talk url or keywords" 56 | , HE.onValueInput $ Just <<< OnValueInput 57 | ] 58 | ] 59 | 60 | render :: State -> HTML 61 | render state = 62 | HH.div 63 | [ class_ "px-4 xl:px-0 bg-white border-b border-grey300 py-4"] 64 | [ HH.div 65 | [ class_ "container flex items-center"] 66 | [ HH.a 67 | [ class_ "font-mono text-xl text-red500 no-underline tracking-tight" 68 | , HP.href "/" 69 | ] 70 | [ HH.text "∷ TED → [SRT]" ] 71 | , renderForm state 72 | ] 73 | ] 74 | 75 | component :: String -> H.Component HH.HTML Query Unit Message Aff 76 | component q = H.mkComponent 77 | { initialState: const $ initialState q 78 | , render 79 | , eval: H.mkEval $ H.defaultEval 80 | { handleAction = handleAction 81 | } 82 | } 83 | 84 | tedPrefix :: String 85 | tedPrefix = "https://www.ted.com/talks/" 86 | 87 | getTalkPageUrl :: String -> String 88 | getTalkPageUrl slug = "/talks/" <> slug 89 | 90 | handleAction :: Action -> DSL Unit 91 | handleAction = case _ of 92 | OnSubmit event -> do 93 | state <- H.get 94 | case String.stripPrefix (String.Pattern tedPrefix) state.value of 95 | Nothing -> pure unit 96 | Just slug -> do 97 | H.liftEffect $ do 98 | Event.preventDefault event 99 | Web.window >>= Window.location >>= 100 | Location.assign (getTalkPageUrl slug) 101 | 102 | OnValueInput value -> do 103 | H.modify_ $ _ { value = value } 104 | -------------------------------------------------------------------------------- /frontend/src/Core/Api.purs: -------------------------------------------------------------------------------- 1 | module Core.Api 2 | ( getTalks 3 | , getTalkTranscript 4 | , searchTalks 5 | ) where 6 | 7 | import Core.Prelude 8 | 9 | import Affjax as AX 10 | import Affjax.ResponseFormat as Res 11 | import Affjax.StatusCode (StatusCode(..)) 12 | import Core.Model (Talk) 13 | import Data.Argonaut.Core (Json) 14 | import Data.Argonaut.Decode (class DecodeJson, decodeJson) 15 | import Data.Either (Either(..)) 16 | import Effect.Aff (Aff) 17 | import Effect.Class (liftEffect) 18 | 19 | type Response a = Aff (Either String a) 20 | 21 | handleResponse 22 | :: forall a 23 | . DecodeJson a 24 | => Either AX.Error (AX.Response Json) 25 | -> Response a 26 | handleResponse = case _ of 27 | Left err -> do 28 | let msg = AX.printError err 29 | void $ liftEffect $ throw msg 30 | pure $ Left msg 31 | Right res -> do 32 | if res.status == StatusCode 200 33 | then case decodeJson res.body of 34 | Left msg -> do 35 | void $ liftEffect $ throw msg 36 | pure $ Left msg 37 | Right v -> pure $ Right v 38 | else case decodeJson res.body of 39 | Left msg -> do 40 | void $ liftEffect $ throw msg 41 | pure $ Left msg 42 | Right (v :: { message :: String }) -> pure $ Left v.message 43 | 44 | get 45 | :: forall a 46 | . DecodeJson a 47 | => AX.URL 48 | -> Response a 49 | get url = AX.get Res.json url >>= handleResponse 50 | 51 | getTalks :: Int -> Response (Array Talk) 52 | getTalks offset = get $ "/api/talks?offset=" <> show offset 53 | 54 | getTalkTranscript :: Talk -> String -> Response String 55 | getTalkTranscript talk lang = do 56 | AX.get Res.string url >>= case _ of 57 | Left err -> do 58 | let msg = AX.printError err 59 | void $ liftEffect $ throw msg 60 | pure $ Left msg 61 | Right res -> do 62 | if res.status == StatusCode 200 63 | then pure $ Right res.body 64 | else do 65 | void $ liftEffect $ throw res.body 66 | pure $ Left res.body 67 | where 68 | url = "/api/talks/" <> show talk.id <> "/transcripts/txt?lang=" <> lang 69 | 70 | searchTalks :: String -> Response (Array Talk) 71 | searchTalks q = get $ "/api/search?q=" <> q 72 | -------------------------------------------------------------------------------- /frontend/src/Core/Model.purs: -------------------------------------------------------------------------------- 1 | module Core.Model where 2 | 3 | import Core.Prelude 4 | 5 | import Data.String as String 6 | 7 | type Language = 8 | { languageCode :: String 9 | , endonym :: String 10 | , languageName :: String 11 | } 12 | 13 | type Talk = 14 | { id :: Int 15 | , slug :: String 16 | , image :: String 17 | , name :: String 18 | , languages :: Array Language 19 | , description :: String 20 | , mediaSlug :: String 21 | -- , publishedAt :: Maybe Date.Date 22 | } 23 | 24 | getTitleSpeaker :: Talk -> { title :: String, speaker :: String } 25 | getTitleSpeaker { name } = 26 | { title: 27 | String.drop 2 $ String.dropWhile (_ /= String.codePointFromChar ':') name 28 | , speaker: String.takeWhile (_ /= String.codePointFromChar ':') name 29 | } 30 | 31 | unescape :: String -> String 32 | unescape = 33 | String.replaceAll (String.Pattern "<") (String.Replacement "<") >>> 34 | String.replaceAll (String.Pattern ">") (String.Replacement ">") >>> 35 | String.replaceAll (String.Pattern "'") (String.Replacement "\'") >>> 36 | String.replaceAll (String.Pattern """) (String.Replacement "\"") >>> 37 | String.replaceAll (String.Pattern "&") (String.Replacement "&") 38 | -------------------------------------------------------------------------------- /frontend/src/Core/Prelude.purs: -------------------------------------------------------------------------------- 1 | module Core.Prelude 2 | ( module Prelude 3 | , module Control.MonadPlus 4 | , module Data.Either 5 | , module Data.Foldable 6 | , module Data.Maybe 7 | , module Data.Symbol 8 | , module Data.Tuple 9 | , module Debug.Trace 10 | , module Effect.Aff 11 | , module Effect.Exception 12 | , class_ 13 | , svgClass_ 14 | , style 15 | ) where 16 | 17 | import Prelude 18 | 19 | import Control.MonadPlus (guard) 20 | import Data.Either (Either(..)) 21 | import Data.Maybe (Maybe(..), isJust) 22 | import Data.Symbol (SProxy(..)) 23 | import Data.Tuple (Tuple(..)) 24 | import Data.Foldable (for_, traverse_) 25 | import Debug.Trace (trace, traceM) 26 | import Effect.Aff (Aff) 27 | import Effect.Exception (throw) 28 | import Halogen.HTML as HH 29 | import Halogen.HTML.Properties as HP 30 | 31 | class_ :: forall r i. String -> HP.IProp ("class" :: String | r) i 32 | class_ = HP.class_ <<< HH.ClassName 33 | 34 | svgClass_ :: forall r i. String -> HP.IProp ("class" :: String | r) i 35 | svgClass_ = HP.attr (HH.AttrName "class") 36 | 37 | style :: forall r i. String -> HP.IProp ("style" :: String | r) i 38 | style = HP.attr (HH.AttrName "style") 39 | -------------------------------------------------------------------------------- /frontend/src/Home.purs: -------------------------------------------------------------------------------- 1 | module Home where 2 | 3 | import Core.Prelude 4 | 5 | import Data.Argonaut.Core (Json) 6 | import Data.Argonaut.Decode (decodeJson) 7 | import Effect (Effect) 8 | import Halogen.Aff (awaitBody, runHalogenAff) 9 | import Halogen.VDom.Driver (runUI) 10 | import Home.App (app) 11 | 12 | main :: Json -> Effect Unit 13 | main f = case decodeJson f of 14 | Left e -> throw e 15 | Right pageData -> 16 | runHalogenAff do 17 | body <- awaitBody 18 | runUI (app pageData) unit body 19 | -------------------------------------------------------------------------------- /frontend/src/Home/App.purs: -------------------------------------------------------------------------------- 1 | module Home.App 2 | ( Query 3 | , app 4 | ) where 5 | 6 | import Core.Prelude 7 | 8 | import Component.Footer as Footer 9 | import Component.Header as Header 10 | import Control.Monad.Trans.Class (lift) 11 | import Core.Api as Api 12 | import Core.Model (Talk, getTitleSpeaker, unescape) 13 | import Data.Array as Array 14 | import Data.Const (Const) 15 | import Data.Maybe (Maybe(..)) 16 | import Halogen as H 17 | import Halogen.HTML as HH 18 | import Halogen.HTML.Events as HE 19 | import Halogen.HTML.Properties as HP 20 | 21 | type PageData = 22 | { talks :: Array Talk 23 | } 24 | 25 | type Query = Const Void 26 | 27 | data Action = LoadMore 28 | 29 | type State = 30 | { talks :: Array Talk 31 | , loading :: Boolean 32 | , hasMore :: Boolean 33 | } 34 | 35 | type Slot = ( header :: H.Slot Header.Query Header.Message Unit ) 36 | 37 | _header = SProxy :: SProxy "header" 38 | 39 | type HTML = H.ComponentHTML Action Slot Aff 40 | 41 | type DSL = H.HalogenM State Action Slot Void Aff 42 | 43 | initialState :: PageData -> State 44 | initialState pageData = 45 | { talks: pageData.talks 46 | , loading: false 47 | , hasMore: true 48 | } 49 | 50 | renderTalk :: Talk -> HTML 51 | renderTalk talk = 52 | HH.li_ 53 | [ HH.a 54 | [ class_ "Link" 55 | , HP.href $ "/talks/" <> talk.slug 56 | ] 57 | [ HH.img 58 | [ HP.src $ unescape talk.image ] 59 | , HH.div [ class_ "py-2"] 60 | [ HH.h3_ 61 | [ HH.text title ] 62 | , HH.div [ class_ "mt-1 text-grey500 text-sm"] 63 | [ HH.text speaker ] 64 | ] 65 | ] 66 | ] 67 | where 68 | { title, speaker } = getTitleSpeaker talk 69 | 70 | render :: State -> HTML 71 | render state = 72 | HH.div_ 73 | [ HH.slot _header unit (Header.component "") unit $ const Nothing 74 | , HH.div 75 | [ class_ "container py-6" ] $ join 76 | [ pure $ HH.ul [ class_ "HomeApp"] $ 77 | state.talks <#> renderTalk 78 | , guard state.hasMore $> HH.div [ class_ "mt-8 text-center"] (join 79 | [ guard (not state.loading) $> HH.button 80 | [ class_ "border py-2 px-6 outline-none text-grey500 hover:text-red500 hover:border-red500" 81 | , HE.onClick $ Just <<< const LoadMore 82 | ] 83 | [ HH.text "LOAD MORE"] 84 | , guard state.loading $> 85 | HH.text "loading..." 86 | ]) 87 | ] 88 | , Footer.render 89 | ] 90 | 91 | app :: PageData -> H.Component HH.HTML Query Unit Void Aff 92 | app pageData = H.mkComponent 93 | { initialState: const $ initialState pageData 94 | , render 95 | , eval: H.mkEval $ H.defaultEval 96 | { handleAction = handleAction } 97 | } 98 | where 99 | handleAction :: Action -> DSL Unit 100 | handleAction LoadMore = do 101 | state <- H.modify $ _ { loading = true } 102 | lift (Api.getTalks $ Array.length state.talks) >>= traverse_ \talks -> 103 | H.modify $ \s -> s 104 | { talks = Array.union s.talks talks 105 | , loading = false 106 | , hasMore = Array.length talks == 20 107 | } 108 | -------------------------------------------------------------------------------- /frontend/src/Home/main.css: -------------------------------------------------------------------------------- 1 | .HomeApp { 2 | display: grid; 3 | grid-gap: 1rem; 4 | padding: 0 1rem; 5 | } 6 | 7 | @screen md { 8 | .HomeApp { 9 | grid-template-columns: 1fr 1fr; 10 | } 11 | } 12 | 13 | @screen lg { 14 | .HomeApp { 15 | grid-template-columns: 1fr 1fr 1fr; 16 | } 17 | } 18 | 19 | @screen xl { 20 | padding: 0; 21 | } 22 | -------------------------------------------------------------------------------- /frontend/src/HomePage.ts: -------------------------------------------------------------------------------- 1 | import * as Main from "Home"; 2 | import "./Home/main.css"; 3 | 4 | const data = { 5 | talks: window.TALKS 6 | }; 7 | 8 | Main.main(data)(); 9 | -------------------------------------------------------------------------------- /frontend/src/Search.purs: -------------------------------------------------------------------------------- 1 | module Search where 2 | 3 | import Core.Prelude 4 | 5 | import Data.Argonaut.Core (Json) 6 | import Data.Argonaut.Decode (decodeJson) 7 | import Effect (Effect) 8 | import Halogen.Aff (awaitBody, runHalogenAff) 9 | import Halogen.VDom.Driver (runUI) 10 | import Search.App (app) 11 | 12 | main :: Json -> Effect Unit 13 | main f = case decodeJson f of 14 | Left e -> throw e 15 | Right pageData -> 16 | runHalogenAff do 17 | body <- awaitBody 18 | runUI (app pageData) unit body 19 | -------------------------------------------------------------------------------- /frontend/src/Search/App.purs: -------------------------------------------------------------------------------- 1 | module Search.App where 2 | 3 | import Core.Prelude 4 | 5 | import Component.Footer as Footer 6 | import Component.Header as Header 7 | import Core.Api as Api 8 | import Core.Model (Talk, unescape) 9 | import Data.Array as Array 10 | import Data.Const (Const) 11 | import Data.Maybe (Maybe(..)) 12 | import Data.Symbol (SProxy(..)) 13 | import Halogen as H 14 | import Halogen.HTML as HH 15 | import Halogen.HTML.Properties as HP 16 | 17 | type PageData = 18 | { q :: String 19 | } 20 | 21 | type Query = Const Void 22 | 23 | data Action = Init 24 | 25 | type State = 26 | { q :: String 27 | , talks :: Array Talk 28 | , loading :: Boolean 29 | } 30 | 31 | type Slot = ( header :: H.Slot Header.Query Header.Message Unit ) 32 | 33 | _header = SProxy :: SProxy "header" 34 | 35 | type HTML = H.ComponentHTML Action Slot Aff 36 | 37 | initialState :: PageData -> State 38 | initialState pageData = 39 | { q: pageData.q 40 | , talks: [] 41 | , loading: false 42 | } 43 | 44 | renderTalk :: Talk -> HTML 45 | renderTalk talk = 46 | HH.li 47 | [ class_ "flex flex-col lg:flex-row mb-6"] 48 | [ HH.a 49 | [ class_ "mr-4 flex-no-shrink Image" 50 | , HP.href $ "/talks/" <> talk.slug 51 | ] 52 | [ HH.img 53 | [ class_ "w-full h-full" 54 | , HP.src $ unescape talk.image 55 | ] 56 | ] 57 | , HH.div_ 58 | [ HH.h3 59 | [ class_ "mb-1 lg:mb-3" ] 60 | [ HH.a 61 | [ class_ "Link" 62 | , HP.href $ "/talks/" <> talk.slug 63 | ] 64 | [ HH.text talk.name ] 65 | ] 66 | , HH.p 67 | [ class_ "leading-normal text-grey500"] 68 | [ HH.text $ unescape talk.description] 69 | ] 70 | ] 71 | 72 | render :: State -> HTML 73 | render state = 74 | HH.div_ 75 | [ HH.slot _header unit (Header.component state.q) unit $ const Nothing 76 | , HH.div 77 | [ class_ "container py-6 px-4 xl:px-0"] $ join 78 | [ pure $ 79 | if Array.length state.talks == 0 80 | then HH.text "Nothing found" 81 | else HH.ul_ $ state.talks <#> renderTalk 82 | , guard state.loading $> HH.div 83 | [ class_ "text-center"] 84 | [ HH.text "loading..."] 85 | ] 86 | , Footer.render 87 | ] 88 | 89 | app :: PageData -> H.Component HH.HTML Query Unit Void Aff 90 | app pageData = H.mkComponent 91 | { initialState: const $ initialState pageData 92 | , render 93 | , eval: H.mkEval $ H.defaultEval 94 | { handleAction = handleAction 95 | , initialize = Just Init} 96 | } 97 | where 98 | handleAction :: Action -> H.HalogenM State Action Slot Void Aff Unit 99 | handleAction Init = do 100 | H.modify_ $ _ { loading = true } 101 | void $ H.fork $ H.liftAff (Api.searchTalks pageData.q) >>= traverse_ \talks -> 102 | H.modify_ $ _ 103 | { talks = talks 104 | , loading = false 105 | } 106 | -------------------------------------------------------------------------------- /frontend/src/Search/main.css: -------------------------------------------------------------------------------- 1 | @screen lg { 2 | .Image { 3 | width: 16rem; 4 | height: 9rem; 5 | } 6 | } 7 | -------------------------------------------------------------------------------- /frontend/src/SearchPage.ts: -------------------------------------------------------------------------------- 1 | import * as Main from "Search"; 2 | import "./Search/main.css"; 3 | 4 | const data = { 5 | q: window.Q 6 | }; 7 | 8 | Main.main(data)(); 9 | -------------------------------------------------------------------------------- /frontend/src/Talk.purs: -------------------------------------------------------------------------------- 1 | module Talk where 2 | 3 | import Core.Prelude 4 | 5 | import Data.Argonaut.Core (Json) 6 | import Data.Argonaut.Decode (decodeJson) 7 | import Effect (Effect) 8 | import Halogen.Aff (awaitBody, runHalogenAff) 9 | import Halogen.VDom.Driver (runUI) 10 | import Talk.App (app) 11 | 12 | main :: Json -> Effect Unit 13 | main f = case decodeJson f of 14 | Left e -> throw e 15 | Right pageData -> 16 | runHalogenAff do 17 | body <- awaitBody 18 | runUI (app pageData) unit body 19 | -------------------------------------------------------------------------------- /frontend/src/Talk/App.purs: -------------------------------------------------------------------------------- 1 | module Talk.App 2 | ( app 3 | ) where 4 | 5 | import Core.Prelude 6 | 7 | import Component.Footer as Footer 8 | import Component.Header as Header 9 | import Core.Api as Api 10 | import Core.Model (unescape) 11 | import Data.Argonaut.Core as A 12 | import Data.Argonaut.Decode (decodeJson) 13 | import Data.Argonaut.Encode (encodeJson) 14 | import Data.Argonaut.Parser (jsonParser) 15 | import Data.Array as Array 16 | import Data.Foldable (sequence_) 17 | import Data.MediaType (MediaType(..)) 18 | import Data.String as String 19 | import Foreign.Object as FO 20 | import Halogen (Namespace(..)) 21 | import Halogen as H 22 | import Halogen.HTML as HH 23 | import Halogen.HTML.Events as HE 24 | import Halogen.HTML.Properties as HP 25 | import Halogen.Query.EventSource as ES 26 | import Talk.Sidebar as Sidebar 27 | import Talk.Types (Action(..), DSL, HTML, PageData, Query, SelectedLang(..), State, _header, initialState) 28 | import Talk.Util as Util 29 | import Web.Event.Event (EventType(..)) 30 | import Web.HTML (HTMLMediaElement, window) 31 | import Web.HTML.HTMLElement as HTML 32 | import Web.HTML.HTMLMediaElement as Media 33 | import Web.HTML.Window as Window 34 | import Web.Storage.Storage as Storage 35 | 36 | 37 | renderTalkInfo :: State -> HTML 38 | renderTalkInfo { talk, selectedLang, playing } = 39 | HH.div_ $ join 40 | [ pure $ HH.h1 [ class_ "text-lg mb-3"] 41 | [ HH.text talk.name ] 42 | , guard (not playing) $> HH.div [ class_ "flex flex-col lg:flex-row"] 43 | [ HH.div 44 | [ class_ "flex-no-shrink cursor-pointer bg-cover bg-center Image" 45 | , style $ "background-image: url(" <> unescape talk.image <> ")" 46 | , HE.onClick $ Just <<< const OnClickPlay 47 | ] 48 | [ HH.div 49 | [ class_ "h-full text-white hover:bg-grey300 flex items-center justify-center"] 50 | [ HH.button 51 | [ class_ "w-8 h-8 text-white text-3xl PlayButton" 52 | ] 53 | [ HH.text "▶" ] 54 | ] 55 | ] 56 | , HH.p [ class_ "mt-2 lg:mt-0 lg:ml-3 leading-normal text-grey500"] 57 | [ HH.text $ unescape talk.description ] 58 | ] 59 | , guard playing $> 60 | HH.video 61 | [ class_ "w-full" 62 | , HP.controls true 63 | , HP.autoplay true 64 | ] 65 | [ HH.source 66 | [ HP.type_ $ MediaType "video/mp4" 67 | , HP.src $ Util.mkVideoUrl talk "950k" ] 68 | , HH.track 69 | [ HP.src $ Util.mkTranscriptUrl talk selectedLang "vtt" 70 | , HP.attr (HH.AttrName "kind") "captions" 71 | , HP.attr (HH.AttrName "default") "" 72 | ] 73 | ] 74 | ] 75 | 76 | renderOneTranscript :: State -> String -> HTML 77 | renderOneTranscript state lang = 78 | case FO.lookup lang state.transcripts of 79 | Nothing -> HH.text "" 80 | Just transcript -> HH.div_ $ 81 | transcript <#> \paragraph -> 82 | HH.p_ 83 | [ HH.text paragraph] 84 | 85 | renderTwoTranscripts :: State -> String -> String -> HTML 86 | renderTwoTranscripts state@{ transcripts } lang1 lang2 = 87 | case FO.lookup lang1 transcripts, FO.lookup lang2 transcripts of 88 | Nothing, Nothing -> HH.text "" 89 | Just _, Nothing -> renderOneTranscript state lang1 90 | Nothing, Just _ -> renderOneTranscript state lang2 91 | Just transcript1, Just transcript2 -> HH.div_ $ 92 | Array.zip transcript1 transcript2 <#> \(Tuple p1 p2) -> 93 | HH.div 94 | [ class_ "Row pb-4 lg:pb-0" ] 95 | [ HH.p_ 96 | [ HH.text p1] 97 | , HH.p_ 98 | [ HH.text p2] 99 | ] 100 | 101 | renderTranscript :: State -> HTML 102 | renderTranscript state = 103 | HH.article 104 | [ class_ "mt-6 leading-normal"] 105 | [ case state.selectedLang of 106 | NoLang -> 107 | HH.div 108 | [ class_ "text-center text-lg mt-8 italic"] 109 | [ HH.text "Select language from sidebar." ] 110 | OneLang lang -> 111 | renderOneTranscript state lang 112 | TwoLang lang1 lang2 -> 113 | renderTwoTranscripts state lang1 lang2 114 | ] 115 | 116 | audioRef :: H.RefLabel 117 | audioRef = H.RefLabel "audio" 118 | 119 | renderAudio :: State -> HTML 120 | renderAudio state@{ talk } = 121 | HH.div 122 | [ class_ "fixed pin-b pin-r flex items-center mb-5 mr-5 md:mb-8 md:mr-8" 123 | ] 124 | [ HH.div 125 | [ class_ $ if state.audioPlayerExpanded then "flex" else "hidden" 126 | , style "font-family: emoji;" 127 | ] 128 | [ HH.button 129 | [ class_ ctrlBtnCls 130 | , HE.onClick $ Just <<< const OnAudioBackward 131 | ] 132 | [ HH.text "⏪"] 133 | , HH.button 134 | [ class_ ctrlBtnCls 135 | , HE.onClick $ Just <<< const OnAudioForward 136 | ] 137 | [ HH.text "⏩"] 138 | , HH.button 139 | [ class_ ctrlBtnCls 140 | , HE.onClick $ Just <<< const OnStopAudioPlay 141 | ] 142 | [ HH.text "⏹"] 143 | , HH.button 144 | [ class_ ctrlBtnCls 145 | , HE.onClick $ Just <<< const OnToggleAudioPlay 146 | ] 147 | [ HH.text $ if state.audioPlaying then "⏸" else "▶️"] 148 | ] 149 | , HH.button 150 | [ class_ "relative select-none cursor-pointer" 151 | , HE.onClick $ Just <<< const OnToggleAudioControls 152 | ] 153 | [ HH.div 154 | [ class_ $ btnCls <> " w-12 h-12 border-none"] 155 | [ HH.text "🎵" ] 156 | , HH.elementNS svgNS (H.ElemName "svg") 157 | [ svgClass_ "absolute pin" 158 | , HH.attr (HH.AttrName "viewBox") "0 0 48 48"] 159 | [ HH.elementNS svgNS (H.ElemName "circle") 160 | [ svgAttr "cx" "24" 161 | , svgAttr "cy" "24" 162 | , svgAttr "r" "23" 163 | , svgAttr "fill" "none" 164 | , svgAttr "stroke" "rgba(0,0,0,0.12)" 165 | , svgAttr "stroke-width" "2" 166 | ] 167 | [] 168 | ] 169 | , HH.elementNS svgNS (H.ElemName "svg") 170 | [ svgClass_ "absolute pin" 171 | , style "transform: rotate(-90deg)" 172 | , HH.attr (HH.AttrName "viewBox") "0 0 48 48"] 173 | [ HH.elementNS svgNS (H.ElemName "circle") 174 | [ svgAttr "cx" "24" 175 | , svgAttr "cy" "24" 176 | , svgAttr "r" "23" 177 | , svgAttr "fill" "none" 178 | , svgAttr "stroke" "#ff5722" 179 | , svgAttr "stroke-width" "2" 180 | , svgAttr "stroke-dasharray" $ 181 | show (state.audioProgress * perimeter) <> " " <> show perimeter 182 | ] 183 | [] 184 | ] 185 | ] 186 | , HH.audio 187 | [ class_ "" 188 | , HP.src url 189 | , HP.ref audioRef 190 | ] [] 191 | ] 192 | where 193 | btnCls = "flex items-center justify-center border border-grey300 rounded-full bg-white cursor-pointer" 194 | ctrlBtnCls = btnCls <> " w-10 h-10 mr-2" 195 | url = "https://download.ted.com/talks/" <> talk.mediaSlug <> ".mp3" 196 | svgNS :: Namespace 197 | svgNS = Namespace "http://www.w3.org/2000/svg" 198 | svgAttr name value = HH.attr (HH.AttrName name) value 199 | perimeter = 3.14 * 48.0 200 | 201 | render :: State -> HTML 202 | render state = 203 | HH.div_ 204 | [ HH.slot _header unit (Header.component "") unit $ const Nothing 205 | , HH.div 206 | [ class_ "TalkApp container py-6 px-4 xl:px-0"] 207 | [ HH.div_ 208 | [ renderTalkInfo state 209 | , renderTranscript state 210 | ] 211 | , Sidebar.render state 212 | , if state.hasAudio then renderAudio state else HH.text "" 213 | ] 214 | , Footer.render 215 | ] 216 | 217 | app :: PageData -> H.Component HH.HTML Query Unit Void Aff 218 | app pageData@{ talk } = H.mkComponent 219 | { initialState: const $ initialState pageData 220 | , render 221 | , eval: H.mkEval $ H.defaultEval 222 | { handleAction = handleAction 223 | , initialize = Just Init 224 | } 225 | } 226 | where 227 | fetchTranscript :: String -> DSL Unit 228 | fetchTranscript lang = do 229 | state <- H.get 230 | when (not $ FO.member lang state.transcripts) $ 231 | H.liftAff (Api.getTalkTranscript talk lang) >>= traverse_ \txt -> 232 | let 233 | transcript = String.split (String.Pattern "\n") txt 234 | in 235 | H.modify_ $ \s -> s 236 | { transcripts = FO.insert lang transcript s.transcripts 237 | } 238 | 239 | isLangAvailable :: String -> Boolean 240 | isLangAvailable langCode = 241 | isJust $ Array.findIndex (\lang -> lang.languageCode == langCode) talk.languages 242 | 243 | withAudioPlayer :: (HTMLMediaElement -> DSL Unit) -> DSL Unit 244 | withAudioPlayer actions = 245 | H.getHTMLElementRef audioRef >>= traverse_ \el -> do 246 | for_ (Media.fromHTMLElement el) actions 247 | 248 | handleAction :: Action -> DSL Unit 249 | handleAction Init = do 250 | selectedLang <- H.liftEffect $ window >>= Window.localStorage >>= 251 | Storage.getItem "languages" >>= \ml -> pure $ case ml of 252 | Nothing -> OneLang "en" 253 | Just languages -> case decodeJson =<< jsonParser languages of 254 | Right [lang] -> 255 | if isLangAvailable lang 256 | then OneLang lang 257 | else OneLang "en" 258 | Right [lang1, lang2] -> 259 | case isLangAvailable lang1, isLangAvailable lang2 of 260 | true, true -> TwoLang lang1 lang2 261 | true, false -> OneLang lang1 262 | false, true -> OneLang lang2 263 | false, false -> OneLang "en" 264 | _ -> OneLang "en" 265 | H.modify_ $ _ { selectedLang = selectedLang } 266 | 267 | case selectedLang of 268 | NoLang -> pure unit 269 | OneLang lang -> fetchTranscript lang 270 | TwoLang lang1 lang2 -> 271 | -- Cannot use H.fork here, seems postgresql-simple cannot handle 272 | -- concurrent requests well 273 | fetchTranscript lang1 *> fetchTranscript lang2 274 | 275 | H.getHTMLElementRef audioRef >>= traverse_ \el -> do 276 | void $ H.subscribe $ 277 | ES.eventListenerEventSource (EventType "timeupdate") (HTML.toEventTarget el) 278 | (Just <<< HandleAudioProgress) 279 | 280 | void $ H.subscribe $ 281 | ES.eventListenerEventSource (EventType "play") (HTML.toEventTarget el) 282 | (Just <<< HandleAudioPlay) 283 | void $ H.subscribe $ 284 | ES.eventListenerEventSource (EventType "pause") (HTML.toEventTarget el) 285 | (Just <<< HandleAudioPause) 286 | void $ H.subscribe $ 287 | ES.eventListenerEventSource (EventType "error") (HTML.toEventTarget el) 288 | (const $ Just HandleAudioError) 289 | 290 | 291 | handleAction (OnClickLang language) = do 292 | state <- H.get 293 | let 294 | selectedLang = case state.selectedLang of 295 | NoLang -> OneLang language 296 | OneLang lang -> 297 | if lang == language 298 | then NoLang 299 | else TwoLang lang language 300 | TwoLang lang1 lang2 -> 301 | if lang1 == language 302 | then OneLang lang2 303 | else 304 | if lang2 == language 305 | then OneLang lang1 306 | else TwoLang lang1 lang2 307 | H.modify_ $ _ { selectedLang = selectedLang } 308 | let 309 | mLangs = case selectedLang of 310 | NoLang -> Nothing 311 | OneLang lang -> Just [lang] 312 | TwoLang lang1 lang2 -> Just [lang1, lang2] 313 | case mLangs of 314 | Nothing -> H.liftEffect $ window >>= Window.localStorage >>= 315 | Storage.removeItem "languages" 316 | Just langs -> do 317 | sequence_ $ fetchTranscript <$> langs 318 | H.liftEffect $ window >>= Window.localStorage >>= 319 | Storage.setItem "languages" (A.stringify $ encodeJson langs) 320 | 321 | handleAction OnClickPlay = do 322 | H.modify_ $ _ { playing = true } 323 | 324 | handleAction (HandleAudioProgress event) = do 325 | withAudioPlayer \audio -> do 326 | percentage <- H.liftEffect $ do 327 | currentTime <- Media.currentTime audio 328 | duration <- Media.duration audio 329 | pure $ currentTime / duration 330 | H.modify_ $ _ { audioProgress = percentage } 331 | 332 | handleAction (HandleAudioPlay event) = do 333 | H.modify_ $ _ { audioPlaying = true } 334 | 335 | handleAction (HandleAudioPause event) = do 336 | H.modify_ $ _ { audioPlaying = false } 337 | 338 | handleAction OnToggleAudioControls = do 339 | H.modify_ $ \s -> s 340 | { audioPlayerExpanded = not s.audioPlayerExpanded } 341 | 342 | handleAction OnToggleAudioPlay = do 343 | withAudioPlayer \audio -> H.liftEffect $ do 344 | paused <- Media.paused audio 345 | (if paused then Media.play else Media.pause) audio 346 | 347 | handleAction OnStopAudioPlay = do 348 | H.modify_ $ \s -> s { audioPlaying = false } 349 | withAudioPlayer \audio -> H.liftEffect $ do 350 | Media.setCurrentTime 0.0 audio 351 | Media.pause audio 352 | 353 | handleAction OnAudioBackward = do 354 | withAudioPlayer \audio -> H.liftEffect $ do 355 | currentTime <- Media.currentTime audio 356 | duration <- Media.duration audio 357 | Media.setCurrentTime (max (currentTime - 10.0) 0.0) audio 358 | 359 | handleAction OnAudioForward = do 360 | withAudioPlayer \audio -> H.liftEffect $ do 361 | currentTime <- Media.currentTime audio 362 | duration <- Media.duration audio 363 | Media.setCurrentTime (min (currentTime + 10.0) duration) audio 364 | 365 | handleAction HandleAudioError = do 366 | H.modify_ $ _ { hasAudio = false } 367 | -------------------------------------------------------------------------------- /frontend/src/Talk/Sidebar.purs: -------------------------------------------------------------------------------- 1 | module Talk.Sidebar 2 | ( render 3 | ) where 4 | 5 | import Core.Prelude 6 | 7 | import Core.Model (Talk) 8 | import Halogen.HTML as HH 9 | import Halogen.HTML.Events as HE 10 | import Halogen.HTML.Properties as HP 11 | import Talk.Types (Action(..), HTML, SelectedLang(..), State) 12 | import Talk.Util as Util 13 | 14 | type Video = 15 | { name :: String 16 | , bitrate :: String 17 | , resolution :: String 18 | } 19 | 20 | mkVideo :: String -> String -> String -> Video 21 | mkVideo = { name: _, bitrate: _, resolution: _} 22 | 23 | videos :: Array Video 24 | videos = 25 | [ mkVideo "720p" "1500k" "1280x720" 26 | , mkVideo "480p" "950k" "854x480" 27 | , mkVideo "360p" "600k" "640x360" 28 | , mkVideo "280p" "320k" "512x288" 29 | ] 30 | 31 | titleCls :: String 32 | titleCls = "text-sm font-normal text-grey500" 33 | 34 | itemCls :: String 35 | itemCls = "py-1 px-3 text-sm cursor-pointer" 36 | 37 | renderVideo :: Talk -> HTML 38 | renderVideo talk = 39 | HH.div 40 | [ class_ "w-1/2 lg:w-full"] 41 | [ HH.h4 [ class_ titleCls] 42 | [ HH.text "Download Video"] 43 | , HH.ul [ class_ "py-1 mb-4"] $ 44 | videos <#> \video -> 45 | HH.li_ 46 | [ HH.a 47 | [ class_ $ itemCls <> " Link block" 48 | , HP.href $ Util.mkVideoUrl talk video.bitrate 49 | , HP.title $ "Resolution: " <> video.resolution 50 | ] 51 | [ HH.text video.name ] 52 | ] 53 | ] 54 | 55 | renderTranscript :: State -> HTML 56 | renderTranscript { talk, selectedLang } = 57 | HH.div_ 58 | [ HH.h4 [ class_ titleCls] 59 | [ HH.text "Download Transcript"] 60 | , HH.ul [ class_ "py-1 mb-4"] $ 61 | ["txt", "srt"] <#> \format -> 62 | HH.li_ 63 | [ HH.a 64 | [ class_ $ itemCls <> " Link block uppercase" 65 | , HP.href $ Util.mkTranscriptDownloadUrl talk selectedLang format 66 | ] 67 | [ HH.text format] 68 | ] 69 | ] 70 | 71 | isLangSelected :: SelectedLang -> String -> Boolean 72 | isLangSelected selected language = 73 | case selected of 74 | NoLang -> false 75 | OneLang lang -> lang == language 76 | TwoLang lang1 lang2 -> lang1 == language || lang2 == language 77 | 78 | renderLanguages :: State -> HTML 79 | renderLanguages { talk, selectedLang } = 80 | HH.div_ 81 | [ HH.h4 [ class_ titleCls] 82 | [ HH.text "Select Languages"] 83 | , HH.ul [ class_ "py-1 mb-4 flex flex-wrap lg:flex-nowrap lg:flex-col"] $ 84 | talk.languages <#> \language -> 85 | HH.li 86 | [ class_ $ getCls language.languageCode 87 | , style "margin-bottom: 2px;" 88 | , HE.onClick $ Just <<< const (OnClickLang language.languageCode) 89 | ] $ join 90 | [ pure $ HH.text language.endonym 91 | , guard (isLangSelected selectedLang language.languageCode) $> 92 | HH.span [ class_ "text-lg ml-3"] 93 | [ HH.text "×" ] 94 | ] 95 | ] 96 | where 97 | baseCls = itemCls <> " flex items-center justify-between" 98 | activeCls = baseCls <> " bg-red500 text-white" 99 | getCls lang = if isLangSelected selectedLang lang then activeCls else baseCls 100 | 101 | render :: State -> HTML 102 | render state = 103 | HH.div 104 | [ class_ "Sidebar" ] 105 | [ renderVideo state.talk 106 | , renderTranscript state 107 | , renderLanguages state 108 | , HH.div 109 | [ class_ "mt-8"] 110 | [ HH.a 111 | [ class_ "Link text-grey500" 112 | , HP.href $ "https://www.ted.com/talks/" <> state.talk.slug 113 | , HP.rel "nofollow" 114 | ] 115 | [ HH.text "🔗 Go to www.ted.com"] 116 | ] 117 | ] 118 | -------------------------------------------------------------------------------- /frontend/src/Talk/Types.purs: -------------------------------------------------------------------------------- 1 | module Talk.Types where 2 | 3 | import Core.Prelude 4 | 5 | import Component.Header as Header 6 | import Core.Model (Talk) 7 | import Data.Const (Const) 8 | import Foreign.Object as FO 9 | import Halogen as H 10 | import Web.Event.Event as Web 11 | 12 | type PageData = 13 | { talk :: Talk 14 | } 15 | 16 | data SelectedLang 17 | = NoLang 18 | | OneLang String 19 | | TwoLang String String 20 | 21 | type Query = Const Void 22 | 23 | data Action 24 | = Init 25 | | OnClickLang String 26 | | OnClickPlay 27 | | HandleAudioProgress Web.Event 28 | | HandleAudioPlay Web.Event 29 | | HandleAudioPause Web.Event 30 | | HandleAudioError 31 | | OnToggleAudioControls 32 | | OnToggleAudioPlay 33 | | OnStopAudioPlay 34 | | OnAudioBackward 35 | | OnAudioForward 36 | 37 | type State = 38 | { talk :: Talk 39 | , selectedLang :: SelectedLang 40 | , transcripts :: FO.Object (Array String) 41 | , playing :: Boolean 42 | , hasAudio :: Boolean 43 | , audioPlayerExpanded :: Boolean 44 | , audioPlaying :: Boolean 45 | , audioProgress :: Number 46 | } 47 | 48 | type Slot = ( header :: H.Slot Header.Query Header.Message Unit ) 49 | 50 | _header = SProxy :: SProxy "header" 51 | 52 | type HTML = H.ComponentHTML Action Slot Aff 53 | 54 | type DSL = H.HalogenM State Action Slot Void Aff 55 | 56 | initialState :: PageData -> State 57 | initialState pageData = 58 | { talk: pageData.talk 59 | , selectedLang: NoLang 60 | , transcripts: FO.empty 61 | , playing: false 62 | , hasAudio: true 63 | , audioPlayerExpanded: false 64 | , audioPlaying: false 65 | , audioProgress: 0.0 66 | } 67 | -------------------------------------------------------------------------------- /frontend/src/Talk/Util.purs: -------------------------------------------------------------------------------- 1 | module Talk.Util 2 | ( mkVideoUrl 3 | , mkTranscriptUrl 4 | , mkTranscriptDownloadUrl 5 | ) where 6 | 7 | import Core.Prelude 8 | 9 | import Core.Model (Talk) 10 | import Talk.Types (SelectedLang(..)) 11 | 12 | mkVideoUrl :: Talk -> String -> String 13 | mkVideoUrl talk bitrate = 14 | "https://download.ted.com/talks/" 15 | <> talk.mediaSlug 16 | <> "-" 17 | <> bitrate 18 | <> ".mp4" 19 | 20 | mkTranscriptUrl' :: Boolean -> Talk -> SelectedLang -> String -> String 21 | mkTranscriptUrl' download talk selectedLang format = 22 | "/api/talks/" <> show talk.id <> "/transcripts/" <> downloadSlug <> format <> query 23 | where 24 | query = case selectedLang of 25 | NoLang -> "?lang=en" 26 | OneLang lang -> "?lang=" <> lang 27 | TwoLang lang1 lang2 -> "?lang=" <> lang1 <> "&lang=" <> lang2 28 | downloadSlug = if download then "download/" else "" 29 | 30 | mkTranscriptUrl :: Talk -> SelectedLang -> String -> String 31 | mkTranscriptUrl = mkTranscriptUrl' false 32 | 33 | mkTranscriptDownloadUrl :: Talk -> SelectedLang -> String -> String 34 | mkTranscriptDownloadUrl = mkTranscriptUrl' true 35 | -------------------------------------------------------------------------------- /frontend/src/Talk/main.css: -------------------------------------------------------------------------------- 1 | .TalkApp { 2 | display: grid; 3 | } 4 | 5 | article p { 6 | margin-bottom: 0.75rem; 7 | } 8 | 9 | .PlayButton { 10 | opacity: 0.8; 11 | transition: all 0.5s; 12 | } 13 | 14 | .Image { 15 | width: 100%; 16 | height: 11rem; 17 | } 18 | 19 | .Image:hover .PlayButton { 20 | opacity: 1; 21 | transform: scale(1.5); 22 | } 23 | 24 | .Sidebar { 25 | display: flex; 26 | flex-wrap: wrap; 27 | } 28 | 29 | @screen lg { 30 | .TalkApp { 31 | grid-template-columns: 1fr auto; 32 | grid-gap: 4rem; 33 | } 34 | 35 | .Image { 36 | width: 16rem; 37 | height: 9rem; 38 | } 39 | 40 | .Row { 41 | display: grid; 42 | grid-template-columns: 1fr 1fr; 43 | grid-gap: 2rem; 44 | } 45 | 46 | .Sidebar { 47 | flex-wrap: nowrap; 48 | flex-direction: column; 49 | width: 14rem; 50 | } 51 | } 52 | -------------------------------------------------------------------------------- /frontend/src/TalkPage.ts: -------------------------------------------------------------------------------- 1 | import * as Main from "Talk"; 2 | import "./Talk/main.css"; 3 | 4 | const data = { 5 | talk: window.TALK 6 | }; 7 | 8 | Main.main(data)(); 9 | -------------------------------------------------------------------------------- /frontend/src/common.css: -------------------------------------------------------------------------------- 1 | @import "tailwindcss/preflight"; 2 | @import "tailwindcss/components"; 3 | 4 | @import "./styles/Link.css"; 5 | 6 | @import "tailwindcss/utilities"; 7 | 8 | html { 9 | @apply text-black; 10 | -webkit-font-smoothing: antialiased; 11 | } 12 | 13 | button:focus, 14 | div:focus { 15 | outline: none; 16 | } 17 | 18 | ul { 19 | @apply list-reset; 20 | } 21 | 22 | video::-webkit-media-text-track-display { 23 | font-size: 1.5rem; 24 | } 25 | 26 | .container { 27 | max-width: 1024px; 28 | } 29 | -------------------------------------------------------------------------------- /frontend/src/common.ts: -------------------------------------------------------------------------------- 1 | import "./common.css"; 2 | -------------------------------------------------------------------------------- /frontend/src/index.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | TED2srt: Download bilingual subtitles of TED talks 8 | 9 | 10 | 11 | 23 | 24 | 25 | 34 | 35 | 36 | -------------------------------------------------------------------------------- /frontend/src/purs.d.ts: -------------------------------------------------------------------------------- 1 | declare module "Home" { 2 | export function main(args: any): any; 3 | } 4 | 5 | declare module "Talk" { 6 | export function main(args: any): any; 7 | } 8 | 9 | declare module "Search" { 10 | export function main(args: any): any; 11 | } 12 | 13 | interface Window { 14 | TALKS: any; 15 | TALK: any; 16 | Q: any; 17 | } 18 | -------------------------------------------------------------------------------- /frontend/src/styles/Link.css: -------------------------------------------------------------------------------- 1 | .Link { 2 | @apply text-black no-underline; 3 | } 4 | 5 | .Link:hover { 6 | @apply text-red500; 7 | } 8 | -------------------------------------------------------------------------------- /frontend/tailwind.js: -------------------------------------------------------------------------------- 1 | /* 2 | 3 | Tailwind - The Utility-First CSS Framework 4 | 5 | A project by Adam Wathan (@adamwathan), Jonathan Reinink (@reinink), 6 | David Hemphill (@davidhemphill) and Steve Schoger (@steveschoger). 7 | 8 | Welcome to the Tailwind config file. This is where you can customize 9 | Tailwind specifically for your project. Don't be intimidated by the 10 | length of this file. It's really just a big JavaScript object and 11 | we've done our very best to explain each section. 12 | 13 | View the full documentation at https://tailwindcss.com. 14 | 15 | 16 | |------------------------------------------------------------------------------- 17 | | The default config 18 | |------------------------------------------------------------------------------- 19 | | 20 | | This variable contains the default Tailwind config. You don't have 21 | | to use it, but it can sometimes be helpful to have available. For 22 | | example, you may choose to merge your custom configuration 23 | | values with some of the Tailwind defaults. 24 | | 25 | */ 26 | 27 | // let defaultConfig = require('tailwindcss/defaultConfig')() 28 | 29 | /* 30 | |------------------------------------------------------------------------------- 31 | | Colors https://tailwindcss.com/docs/colors 32 | |------------------------------------------------------------------------------- 33 | | 34 | | Here you can specify the colors used in your project. To get you started, 35 | | we've provided a generous palette of great looking colors that are perfect 36 | | for prototyping, but don't hesitate to change them for your project. You 37 | | own these colors, nothing will break if you change everything about them. 38 | | 39 | | We've used literal color names ("red", "blue", etc.) for the default 40 | | palette, but if you'd rather use functional names like "primary" and 41 | | "secondary", or even a numeric scale like "100" and "200", go for it. 42 | | 43 | */ 44 | 45 | let colors = { 46 | transparent: "transparent", 47 | 48 | black: "#212121", 49 | grey500: "rgba(0, 0, 0, 0.54)", 50 | grey400: "rgba(0, 0, 0, 0.26)", 51 | grey300: "rgba(0, 0, 0, 0.12)", 52 | white: "#ffffff", 53 | 54 | red500: "#ff5722" 55 | }; 56 | 57 | module.exports = { 58 | /* 59 | |----------------------------------------------------------------------------- 60 | | Colors https://tailwindcss.com/docs/colors 61 | |----------------------------------------------------------------------------- 62 | | 63 | | The color palette defined above is also assigned to the "colors" key of 64 | | your Tailwind config. This makes it easy to access them in your CSS 65 | | using Tailwind's config helper. For example: 66 | | 67 | | .error { color: config('colors.red') } 68 | | 69 | */ 70 | 71 | colors: colors, 72 | 73 | /* 74 | |----------------------------------------------------------------------------- 75 | | Screens https://tailwindcss.com/docs/responsive-design 76 | |----------------------------------------------------------------------------- 77 | | 78 | | Screens in Tailwind are translated to CSS media queries. They define the 79 | | responsive breakpoints for your project. By default Tailwind takes a 80 | | "mobile first" approach, where each screen size represents a minimum 81 | | viewport width. Feel free to have as few or as many screens as you 82 | | want, naming them in whatever way you'd prefer for your project. 83 | | 84 | | Tailwind also allows for more complex screen definitions, which can be 85 | | useful in certain situations. Be sure to see the full responsive 86 | | documentation for a complete list of options. 87 | | 88 | | Class name: .{screen}:{utility} 89 | | 90 | */ 91 | 92 | screens: { 93 | sm: "576px", 94 | md: "768px", 95 | lg: "1024px", 96 | xl: "1056px" 97 | }, 98 | 99 | /* 100 | |----------------------------------------------------------------------------- 101 | | Fonts https://tailwindcss.com/docs/fonts 102 | |----------------------------------------------------------------------------- 103 | | 104 | | Here is where you define your project's font stack, or font families. 105 | | Keep in mind that Tailwind doesn't actually load any fonts for you. 106 | | If you're using custom fonts you'll need to import them prior to 107 | | defining them here. 108 | | 109 | | By default we provide a native font stack that works remarkably well on 110 | | any device or OS you're using, since it just uses the default fonts 111 | | provided by the platform. 112 | | 113 | | Class name: .font-{name} 114 | | 115 | */ 116 | 117 | fonts: { 118 | sans: [ 119 | "system-ui", 120 | "BlinkMacSystemFont", 121 | "-apple-system", 122 | "Segoe UI", 123 | "Roboto", 124 | "Oxygen", 125 | "Ubuntu", 126 | "Cantarell", 127 | "Fira Sans", 128 | "Droid Sans", 129 | "Helvetica Neue", 130 | "sans-serif" 131 | ], 132 | serif: [ 133 | "Constantia", 134 | "Lucida Bright", 135 | "Lucidabright", 136 | "Lucida Serif", 137 | "Lucida", 138 | "DejaVu Serif", 139 | "Bitstream Vera Serif", 140 | "Liberation Serif", 141 | "Georgia", 142 | "serif" 143 | ], 144 | mono: [ 145 | "Menlo", 146 | "Monaco", 147 | "Consolas", 148 | "Liberation Mono", 149 | "Courier New", 150 | "monospace" 151 | ] 152 | }, 153 | 154 | /* 155 | |----------------------------------------------------------------------------- 156 | | Text sizes https://tailwindcss.com/docs/text-sizing 157 | |----------------------------------------------------------------------------- 158 | | 159 | | Here is where you define your text sizes. Name these in whatever way 160 | | makes the most sense to you. We use size names by default, but 161 | | you're welcome to use a numeric scale or even something else 162 | | entirely. 163 | | 164 | | By default Tailwind uses the "rem" unit type for most measurements. 165 | | This allows you to set a root font size which all other sizes are 166 | | then based on. That said, you are free to use whatever units you 167 | | prefer, be it rems, ems, pixels or other. 168 | | 169 | | Class name: .text-{size} 170 | | 171 | */ 172 | 173 | textSizes: { 174 | xs: ".75rem", // 12px 175 | sm: ".875rem", // 14px 176 | base: "1rem", // 16px 177 | lg: "1.125rem", // 18px 178 | xl: "1.25rem", // 20px 179 | "2xl": "1.5rem", // 24px 180 | "3xl": "1.875rem", // 30px 181 | "4xl": "2.25rem", // 36px 182 | "5xl": "3rem" // 48px 183 | }, 184 | 185 | /* 186 | |----------------------------------------------------------------------------- 187 | | Font weights https://tailwindcss.com/docs/font-weight 188 | |----------------------------------------------------------------------------- 189 | | 190 | | Here is where you define your font weights. We've provided a list of 191 | | common font weight names with their respective numeric scale values 192 | | to get you started. It's unlikely that your project will require 193 | | all of these, so we recommend removing those you don't need. 194 | | 195 | | Class name: .font-{weight} 196 | | 197 | */ 198 | 199 | fontWeights: { 200 | hairline: 100, 201 | thin: 200, 202 | light: 300, 203 | normal: 400, 204 | medium: 500, 205 | semibold: 600, 206 | bold: 700, 207 | extrabold: 800, 208 | black: 900 209 | }, 210 | 211 | /* 212 | |----------------------------------------------------------------------------- 213 | | Leading (line height) https://tailwindcss.com/docs/line-height 214 | |----------------------------------------------------------------------------- 215 | | 216 | | Here is where you define your line height values, or as we call 217 | | them in Tailwind, leadings. 218 | | 219 | | Class name: .leading-{size} 220 | | 221 | */ 222 | 223 | leading: { 224 | none: 1, 225 | tight: 1.25, 226 | normal: 1.5, 227 | loose: 2 228 | }, 229 | 230 | /* 231 | |----------------------------------------------------------------------------- 232 | | Tracking (letter spacing) https://tailwindcss.com/docs/letter-spacing 233 | |----------------------------------------------------------------------------- 234 | | 235 | | Here is where you define your letter spacing values, or as we call 236 | | them in Tailwind, tracking. 237 | | 238 | | Class name: .tracking-{size} 239 | | 240 | */ 241 | 242 | tracking: { 243 | tight: "-0.05em", 244 | normal: "0", 245 | wide: "0.05em" 246 | }, 247 | 248 | /* 249 | |----------------------------------------------------------------------------- 250 | | Text colors https://tailwindcss.com/docs/text-color 251 | |----------------------------------------------------------------------------- 252 | | 253 | | Here is where you define your text colors. By default these use the 254 | | color palette we defined above, however you're welcome to set these 255 | | independently if that makes sense for your project. 256 | | 257 | | Class name: .text-{color} 258 | | 259 | */ 260 | 261 | textColors: colors, 262 | 263 | /* 264 | |----------------------------------------------------------------------------- 265 | | Background colors https://tailwindcss.com/docs/background-color 266 | |----------------------------------------------------------------------------- 267 | | 268 | | Here is where you define your background colors. By default these use 269 | | the color palette we defined above, however you're welcome to set 270 | | these independently if that makes sense for your project. 271 | | 272 | | Class name: .bg-{color} 273 | | 274 | */ 275 | 276 | backgroundColors: colors, 277 | 278 | /* 279 | |----------------------------------------------------------------------------- 280 | | Background sizes https://tailwindcss.com/docs/background-size 281 | |----------------------------------------------------------------------------- 282 | | 283 | | Here is where you define your background sizes. We provide some common 284 | | values that are useful in most projects, but feel free to add other sizes 285 | | that are specific to your project here as well. 286 | | 287 | | Class name: .bg-{size} 288 | | 289 | */ 290 | 291 | backgroundSize: { 292 | auto: "auto", 293 | cover: "cover", 294 | contain: "contain" 295 | }, 296 | 297 | /* 298 | |----------------------------------------------------------------------------- 299 | | Border widths https://tailwindcss.com/docs/border-width 300 | |----------------------------------------------------------------------------- 301 | | 302 | | Here is where you define your border widths. Take note that border 303 | | widths require a special "default" value set as well. This is the 304 | | width that will be used when you do not specify a border width. 305 | | 306 | | Class name: .border{-side?}{-width?} 307 | | 308 | */ 309 | 310 | borderWidths: { 311 | default: "1px", 312 | "0": "0", 313 | "2": "2px", 314 | "4": "4px", 315 | "8": "8px" 316 | }, 317 | 318 | /* 319 | |----------------------------------------------------------------------------- 320 | | Border colors https://tailwindcss.com/docs/border-color 321 | |----------------------------------------------------------------------------- 322 | | 323 | | Here is where you define your border colors. By default these use the 324 | | color palette we defined above, however you're welcome to set these 325 | | independently if that makes sense for your project. 326 | | 327 | | Take note that border colors require a special "default" value set 328 | | as well. This is the color that will be used when you do not 329 | | specify a border color. 330 | | 331 | | Class name: .border-{color} 332 | | 333 | */ 334 | 335 | borderColors: global.Object.assign({ default: colors.grey400 }, colors), 336 | 337 | /* 338 | |----------------------------------------------------------------------------- 339 | | Border radius https://tailwindcss.com/docs/border-radius 340 | |----------------------------------------------------------------------------- 341 | | 342 | | Here is where you define your border radius values. If a `default` radius 343 | | is provided, it will be made available as the non-suffixed `.rounded` 344 | | utility. 345 | | 346 | | If your scale includes a `0` value to reset already rounded corners, it's 347 | | a good idea to put it first so other values are able to override it. 348 | | 349 | | Class name: .rounded{-side?}{-size?} 350 | | 351 | */ 352 | 353 | borderRadius: { 354 | none: "0", 355 | sm: ".125rem", 356 | default: ".25rem", 357 | lg: ".5rem", 358 | full: "9999px" 359 | }, 360 | 361 | /* 362 | |----------------------------------------------------------------------------- 363 | | Width https://tailwindcss.com/docs/width 364 | |----------------------------------------------------------------------------- 365 | | 366 | | Here is where you define your width utility sizes. These can be 367 | | percentage based, pixels, rems, or any other units. By default 368 | | we provide a sensible rem based numeric scale, a percentage 369 | | based fraction scale, plus some other common use-cases. You 370 | | can, of course, modify these values as needed. 371 | | 372 | | 373 | | It's also worth mentioning that Tailwind automatically escapes 374 | | invalid CSS class name characters, which allows you to have 375 | | awesome classes like .w-2/3. 376 | | 377 | | Class name: .w-{size} 378 | | 379 | */ 380 | 381 | width: { 382 | auto: "auto", 383 | px: "1px", 384 | "1": "0.25rem", 385 | "2": "0.5rem", 386 | "3": "0.75rem", 387 | "4": "1rem", 388 | "5": "1.25rem", 389 | "6": "1.5rem", 390 | "8": "2rem", 391 | "10": "2.5rem", 392 | "12": "3rem", 393 | "1/2": "50%", 394 | full: "100%", 395 | screen: "100vw" 396 | }, 397 | 398 | /* 399 | |----------------------------------------------------------------------------- 400 | | Height https://tailwindcss.com/docs/height 401 | |----------------------------------------------------------------------------- 402 | | 403 | | Here is where you define your height utility sizes. These can be 404 | | percentage based, pixels, rems, or any other units. By default 405 | | we provide a sensible rem based numeric scale plus some other 406 | | common use-cases. You can, of course, modify these values as 407 | | needed. 408 | | 409 | | Class name: .h-{size} 410 | | 411 | */ 412 | 413 | height: { 414 | auto: "auto", 415 | px: "1px", 416 | "1": "0.25rem", 417 | "2": "0.5rem", 418 | "3": "0.75rem", 419 | "4": "1rem", 420 | "5": "1.25rem", 421 | "6": "1.5rem", 422 | "8": "2rem", 423 | "10": "2.5rem", 424 | "12": "3rem", 425 | full: "100%", 426 | screen: "100vh" 427 | }, 428 | 429 | /* 430 | |----------------------------------------------------------------------------- 431 | | Minimum width https://tailwindcss.com/docs/min-width 432 | |----------------------------------------------------------------------------- 433 | | 434 | | Here is where you define your minimum width utility sizes. These can 435 | | be percentage based, pixels, rems, or any other units. We provide a 436 | | couple common use-cases by default. You can, of course, modify 437 | | these values as needed. 438 | | 439 | | Class name: .min-w-{size} 440 | | 441 | */ 442 | 443 | minWidth: { 444 | "0": "0", 445 | full: "100%" 446 | }, 447 | 448 | /* 449 | |----------------------------------------------------------------------------- 450 | | Minimum height https://tailwindcss.com/docs/min-height 451 | |----------------------------------------------------------------------------- 452 | | 453 | | Here is where you define your minimum height utility sizes. These can 454 | | be percentage based, pixels, rems, or any other units. We provide a 455 | | few common use-cases by default. You can, of course, modify these 456 | | values as needed. 457 | | 458 | | Class name: .min-h-{size} 459 | | 460 | */ 461 | 462 | minHeight: { 463 | "0": "0", 464 | full: "100%", 465 | screen: "100vh" 466 | }, 467 | 468 | /* 469 | |----------------------------------------------------------------------------- 470 | | Maximum width https://tailwindcss.com/docs/max-width 471 | |----------------------------------------------------------------------------- 472 | | 473 | | Here is where you define your maximum width utility sizes. These can 474 | | be percentage based, pixels, rems, or any other units. By default 475 | | we provide a sensible rem based scale and a "full width" size, 476 | | which is basically a reset utility. You can, of course, 477 | | modify these values as needed. 478 | | 479 | | Class name: .max-w-{size} 480 | | 481 | */ 482 | 483 | maxWidth: { 484 | full: "100%", 485 | screen: "100vw" 486 | }, 487 | 488 | /* 489 | |----------------------------------------------------------------------------- 490 | | Maximum height https://tailwindcss.com/docs/max-height 491 | |----------------------------------------------------------------------------- 492 | | 493 | | Here is where you define your maximum height utility sizes. These can 494 | | be percentage based, pixels, rems, or any other units. We provide a 495 | | couple common use-cases by default. You can, of course, modify 496 | | these values as needed. 497 | | 498 | | Class name: .max-h-{size} 499 | | 500 | */ 501 | 502 | maxHeight: { 503 | full: "100%", 504 | screen: "100vh" 505 | }, 506 | 507 | /* 508 | |----------------------------------------------------------------------------- 509 | | Padding https://tailwindcss.com/docs/padding 510 | |----------------------------------------------------------------------------- 511 | | 512 | | Here is where you define your padding utility sizes. These can be 513 | | percentage based, pixels, rems, or any other units. By default we 514 | | provide a sensible rem based numeric scale plus a couple other 515 | | common use-cases like "1px". You can, of course, modify these 516 | | values as needed. 517 | | 518 | | Class name: .p{side?}-{size} 519 | | 520 | */ 521 | 522 | padding: { 523 | px: "1px", 524 | "0": "0", 525 | "1": "0.25rem", 526 | "2": "0.5rem", 527 | "3": "0.75rem", 528 | "4": "1rem", 529 | "5": "1.25rem", 530 | "6": "1.5rem", 531 | "8": "2rem", 532 | "10": "2.5rem" 533 | }, 534 | 535 | /* 536 | |----------------------------------------------------------------------------- 537 | | Margin https://tailwindcss.com/docs/margin 538 | |----------------------------------------------------------------------------- 539 | | 540 | | Here is where you define your margin utility sizes. These can be 541 | | percentage based, pixels, rems, or any other units. By default we 542 | | provide a sensible rem based numeric scale plus a couple other 543 | | common use-cases like "1px". You can, of course, modify these 544 | | values as needed. 545 | | 546 | | Class name: .m{side?}-{size} 547 | | 548 | */ 549 | 550 | margin: { 551 | auto: "auto", 552 | px: "1px", 553 | "0": "0", 554 | "1": "0.25rem", 555 | "2": "0.5rem", 556 | "3": "0.75rem", 557 | "4": "1rem", 558 | "5": "1.25rem", 559 | "6": "1.5rem", 560 | "8": "2rem", 561 | "10": "2.5rem" 562 | }, 563 | 564 | /* 565 | |----------------------------------------------------------------------------- 566 | | Negative margin https://tailwindcss.com/docs/negative-margin 567 | |----------------------------------------------------------------------------- 568 | | 569 | | Here is where you define your negative margin utility sizes. These can 570 | | be percentage based, pixels, rems, or any other units. By default we 571 | | provide matching values to the padding scale since these utilities 572 | | generally get used together. You can, of course, modify these 573 | | values as needed. 574 | | 575 | | Class name: .-m{side?}-{size} 576 | | 577 | */ 578 | 579 | negativeMargin: { 580 | px: "1px", 581 | "0": "0", 582 | "1": "0.25rem", 583 | "2": "0.5rem", 584 | "3": "0.75rem", 585 | "4": "1rem", 586 | "5": "1.25rem", 587 | "6": "1.5rem", 588 | "8": "2rem", 589 | "10": "2.5rem", 590 | "12": "3rem", 591 | "16": "4rem", 592 | "20": "5rem", 593 | "24": "6rem", 594 | "32": "8rem" 595 | }, 596 | 597 | /* 598 | |----------------------------------------------------------------------------- 599 | | Shadows https://tailwindcss.com/docs/shadows 600 | |----------------------------------------------------------------------------- 601 | | 602 | | Here is where you define your shadow utilities. As you can see from 603 | | the defaults we provide, it's possible to apply multiple shadows 604 | | per utility using comma separation. 605 | | 606 | | If a `default` shadow is provided, it will be made available as the non- 607 | | suffixed `.shadow` utility. 608 | | 609 | | Class name: .shadow-{size?} 610 | | 611 | */ 612 | 613 | shadows: { 614 | default: "0 2px 4px 0 rgba(0,0,0,0.10)", 615 | none: "none" 616 | }, 617 | 618 | /* 619 | |----------------------------------------------------------------------------- 620 | | Z-index https://tailwindcss.com/docs/z-index 621 | |----------------------------------------------------------------------------- 622 | | 623 | | Here is where you define your z-index utility values. By default we 624 | | provide a sensible numeric scale. You can, of course, modify these 625 | | values as needed. 626 | | 627 | | Class name: .z-{index} 628 | | 629 | */ 630 | 631 | zIndex: {}, 632 | 633 | /* 634 | |----------------------------------------------------------------------------- 635 | | Opacity https://tailwindcss.com/docs/opacity 636 | |----------------------------------------------------------------------------- 637 | | 638 | | Here is where you define your opacity utility values. By default we 639 | | provide a sensible numeric scale. You can, of course, modify these 640 | | values as needed. 641 | | 642 | | Class name: .opacity-{name} 643 | | 644 | */ 645 | 646 | opacity: { 647 | "0": "0", 648 | "25": ".25", 649 | "50": ".5", 650 | "75": ".75", 651 | "100": "1" 652 | }, 653 | 654 | /* 655 | |----------------------------------------------------------------------------- 656 | | SVG fill https://tailwindcss.com/docs/svg 657 | |----------------------------------------------------------------------------- 658 | | 659 | | Here is where you define your SVG fill colors. By default we just provide 660 | | `fill-current` which sets the fill to the current text color. This lets you 661 | | specify a fill color using existing text color utilities and helps keep the 662 | | generated CSS file size down. 663 | | 664 | | Class name: .fill-{name} 665 | | 666 | */ 667 | 668 | svgFill: { 669 | current: "currentColor" 670 | }, 671 | 672 | /* 673 | |----------------------------------------------------------------------------- 674 | | SVG stroke https://tailwindcss.com/docs/svg 675 | |----------------------------------------------------------------------------- 676 | | 677 | | Here is where you define your SVG stroke colors. By default we just provide 678 | | `stroke-current` which sets the stroke to the current text color. This lets 679 | | you specify a stroke color using existing text color utilities and helps 680 | | keep the generated CSS file size down. 681 | | 682 | | Class name: .stroke-{name} 683 | | 684 | */ 685 | 686 | svgStroke: { 687 | current: "currentColor" 688 | }, 689 | 690 | /* 691 | |----------------------------------------------------------------------------- 692 | | Modules https://tailwindcss.com/docs/configuration#modules 693 | |----------------------------------------------------------------------------- 694 | | 695 | | Here is where you control which modules are generated and what variants are 696 | | generated for each of those modules. 697 | | 698 | | Currently supported variants: 699 | | - responsive 700 | | - hover 701 | | - focus 702 | | - active 703 | | - group-hover 704 | | 705 | | To disable a module completely, use `false` instead of an array. 706 | | 707 | */ 708 | 709 | modules: { 710 | appearance: false, 711 | backgroundAttachment: false, 712 | backgroundColors: [], 713 | backgroundPosition: [], 714 | backgroundRepeat: false, 715 | backgroundSize: [], 716 | borderCollapse: [], 717 | borderColors: ["hover"], 718 | borderRadius: [], 719 | borderStyle: [], 720 | borderWidths: [], 721 | cursor: [], 722 | display: ["responsive"], 723 | flexbox: ["responsive"], 724 | float: false, 725 | fonts: [], 726 | fontWeights: [], 727 | height: ["responsive"], 728 | leading: ["responsive"], 729 | lists: [], 730 | margin: ["responsive"], 731 | maxHeight: [], 732 | maxWidth: [], 733 | minHeight: [], 734 | minWidth: [], 735 | negativeMargin: false, 736 | opacity: false, 737 | outline: [], 738 | overflow: [], 739 | padding: ["responsive"], 740 | pointerEvents: [], 741 | position: ["responsive"], 742 | resize: false, 743 | shadows: [], 744 | svgFill: false, 745 | svgStroke: false, 746 | textAlign: [], 747 | textColors: ["hover"], 748 | textSizes: [], 749 | textStyle: ["hover"], 750 | tracking: [], 751 | userSelect: [], 752 | verticalAlign: false, 753 | visibility: false, 754 | whitespace: [], 755 | width: ["responsive"], 756 | zIndex: [] 757 | }, 758 | 759 | /* 760 | |----------------------------------------------------------------------------- 761 | | Plugins https://tailwindcss.com/docs/plugins 762 | |----------------------------------------------------------------------------- 763 | | 764 | | Here is where you can register any plugins you'd like to use in your 765 | | project. Tailwind's built-in `container` plugin is enabled by default to 766 | | give you a Bootstrap-style responsive container component out of the box. 767 | | 768 | | Be sure to view the complete plugin documentation to learn more about how 769 | | the plugin system works. 770 | | 771 | */ 772 | 773 | plugins: [ 774 | require("tailwindcss/plugins/container")({ 775 | center: true 776 | // padding: '1rem', 777 | }) 778 | ], 779 | 780 | /* 781 | |----------------------------------------------------------------------------- 782 | | Advanced Options https://tailwindcss.com/docs/configuration#options 783 | |----------------------------------------------------------------------------- 784 | | 785 | | Here is where you can tweak advanced configuration options. We recommend 786 | | leaving these options alone unless you absolutely need to change them. 787 | | 788 | */ 789 | 790 | options: { 791 | prefix: "", 792 | important: false, 793 | separator: ":" 794 | } 795 | }; 796 | -------------------------------------------------------------------------------- /frontend/tsconfig.json: -------------------------------------------------------------------------------- 1 | { 2 | "compilerOptions": { 3 | "module": "commonjs", 4 | "target": "ES5", 5 | "lib": ["dom", "dom.iterable", "es7"], 6 | "strict": true 7 | } 8 | } 9 | -------------------------------------------------------------------------------- /frontend/webpack.config.js: -------------------------------------------------------------------------------- 1 | const webpack = require("webpack"); 2 | const ExtractTextPlugin = require("extract-text-webpack-plugin"); 3 | 4 | let mode; 5 | let resolveModules; 6 | 7 | const rules = [ 8 | { 9 | test: /\.ts$/, 10 | use: ["ts-loader"] 11 | } 12 | ]; 13 | const plugins = []; 14 | 15 | if (process.env.NODE_ENV === "production") { 16 | mode = "production"; 17 | 18 | resolveModules = ["node_modules", "dce-output", "src"]; 19 | 20 | rules.push({ 21 | test: /\.css$/, 22 | use: ExtractTextPlugin.extract({ 23 | fallback: "style-loader", 24 | use: [ 25 | { 26 | loader: "css-loader", 27 | options: { importLoaders: 1 } 28 | }, 29 | "postcss-loader" 30 | ] 31 | }) 32 | }); 33 | 34 | plugins.push( 35 | new ExtractTextPlugin({ 36 | filename: "[name].css", 37 | allChunks: true 38 | }) 39 | ); 40 | } else { 41 | mode = "development"; 42 | 43 | resolveModules = ["node_modules", "output", "src"]; 44 | 45 | rules.push({ 46 | test: /\.css$/, 47 | use: [ 48 | "style-loader", 49 | { 50 | loader: "css-loader", 51 | options: { importLoaders: 1 } 52 | }, 53 | "postcss-loader" 54 | ] 55 | }); 56 | } 57 | 58 | console.warn("------------------------------------------"); 59 | console.warn("webpack running in mode: ", mode); 60 | console.warn("------------------------------------------"); 61 | 62 | module.exports = { 63 | context: __dirname, 64 | mode, 65 | target: "web", 66 | entry: { 67 | Home: ["./src/common.ts", "./src/HomePage.ts"], 68 | Talk: ["./src/common.ts", "./src/TalkPage.ts"], 69 | Search: ["./src/common.ts", "./src/SearchPage.ts"] 70 | }, 71 | output: { 72 | path: __dirname + "/../backend/dist", 73 | filename: "[name].js", 74 | publicPath: "/" 75 | }, 76 | resolve: { 77 | modules: resolveModules, 78 | extensions: [".js", ".ts"] 79 | }, 80 | module: { 81 | rules 82 | }, 83 | plugins, 84 | optimization: { 85 | splitChunks: { 86 | cacheGroups: { 87 | common: { 88 | name: "common", 89 | chunks: "initial", 90 | minChunks: 3 91 | } 92 | } 93 | } 94 | }, 95 | devServer: { 96 | host: "0.0.0.0", 97 | historyApiFallback: true, 98 | proxy: { 99 | "/api": { 100 | target: "http://localhost:3001", 101 | secure: false, 102 | pathRewrite: { 103 | "^/api": "" 104 | } 105 | } 106 | } 107 | } 108 | }; 109 | -------------------------------------------------------------------------------- /nix/all.nix: -------------------------------------------------------------------------------- 1 | { nixpkgs ? import ./nixpkgs.nix {} 2 | , compiler ? "ghc864" 3 | }: 4 | 5 | let 6 | global = { inherit nixpkgs compiler; }; 7 | 8 | in { 9 | with-utf8 = import ./pkgs/with-utf8.nix global; 10 | } 11 | -------------------------------------------------------------------------------- /nix/nixpkgs.nix: -------------------------------------------------------------------------------- 1 | import (fetchTarball https://github.com/NixOS/nixpkgs/archive/86191b5b91322bdd88303e31d4507a684fc1b120.tar.gz) 2 | -------------------------------------------------------------------------------- /nix/pkgs/with-utf8.nix: -------------------------------------------------------------------------------- 1 | { nixpkgs 2 | , compiler 3 | , callPackage ? nixpkgs.pkgs.haskell.packages.${compiler}.callPackage 4 | }: 5 | let with-utf8 = callPackage 6 | ({ mkDerivation, base, deepseq, hedgehog, HUnit, safe-exceptions 7 | , tasty, tasty-discover, tasty-hedgehog, tasty-hunit, temporary 8 | , text, unix, stdenv 9 | }: 10 | mkDerivation { 11 | pname = "with-utf8"; 12 | version = "1.0.0.0"; 13 | sha256 = "06xznaszw7d6rznvzhzw3y4z31b4vx4djms85rq4qsbpfbdrh2zc"; 14 | libraryHaskellDepends = [ base safe-exceptions text ]; 15 | testHaskellDepends = [ 16 | base deepseq hedgehog HUnit safe-exceptions tasty tasty-hedgehog 17 | tasty-hunit temporary text unix 18 | ]; 19 | testToolDepends = [ tasty-discover ]; 20 | description = "Get your IO right on the first try"; 21 | license = stdenv.lib.licenses.mpl20; 22 | }) {}; 23 | in nixpkgs.pkgs.haskell.lib.dontHaddock 24 | (nixpkgs.pkgs.haskell.lib.dontCheck with-utf8) 25 | --------------------------------------------------------------------------------