packages feed

flashblast (empty) → 0.0.1.0

raw patch · 8 files changed

+497/−0 lines, 8 filesdep +attoparsecdep +basedep +composite-base

Dependencies added: attoparsec, base, composite-base, dhall, flashblast, formatting, lucid, megaparsec, path, path-dhall-instance, path-utils, polysemy, polysemy-video, replace-megaparsec, rio, semialign, subtitleParser, these, turtle, unliftio-path, vinyl

Files

+ ChangeLog.md view
@@ -0,0 +1,8 @@+# Changelog for flashblast++## (v0.0.1.0)++* Rough draft.+* Working clip, still and audio extraction.+* Working note creation in a format suitable for import into Anki.+* Automatically download videos from YouTube and create flashcards.
+ LICENSE view
@@ -0,0 +1,19 @@+Copyright (c) 2020 Daniel Firth++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.
+ README.md view
@@ -0,0 +1,21 @@+# flashblast++Flashblast is a command line application for creating anki flashcards from a dhall config.++This is in early stages and has some rough edges, but you can try it out using+the [sample decks](https://gitlab.com/homotopic-tech/flashblast-sample-decks) to get+working output.++## Install++```+stack install flashblast+```++## Run++cd to the sample decks repository and run++```+flashblast+```
+ app/Main.hs view
@@ -0,0 +1,224 @@+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE TemplateHaskell       #-}+{-# LANGUAGE UndecidableInstances  #-}++import           Composite.Record+import qualified Data.Attoparsec.Text as A+import           Dhall                hiding (embed, string)+import           Path+import           Path.Dhall           ()+import           Path.Utils+import           Polysemy+import           Polysemy.Error       as P+import           Polysemy.Reader+import           Polysemy.Video++import           Data.Align+import           RIO                  hiding (Reader, ask, asks, many,+                                       runReader)+import           RIO.List+import           RIO.List.Partial+import qualified RIO.Map              as Map+import qualified RIO.Text             as T+import qualified Text.Subtitles.SRT   as SR+import qualified Turtle               as S+import           FlashBlast.AnkiDB+import           FlashBlast.ClozeParse+import           FlashBlast.Conventions++data MultiClozeSpec = MultiClozeSpec {+  phrases :: [Text]+, images  :: [Path Rel File]+} deriving (Eq, Generic, Show)++instance FromDhall MultiClozeSpec++data YDLInfo = YDLInfo {+  url :: Text+, out :: Path Rel File+, format :: Text+} deriving (Eq, Generic, Show)++instance FromDhall YDLInfo+data VideoSource = LocalVideo (Path Rel File) | YouTubeDL YDLInfo+  deriving (Eq, Generic, Show)++instance FromDhall VideoSource++data ExcerptSpec = ExcerptSpec {+  source :: VideoSource+, subs  :: Text+, clipf :: Text -> Text+, audiof :: Text -> Text+, framef :: Text -> Text+} deriving Generic++instance FromDhall ExcerptSpec++data Locale = Locale Text+  deriving (Eq, Show, Generic)++data ExportDirs = ExportDirs {+  audio  :: Path Rel Dir+, clips  :: Path Rel Dir+, images :: Path Rel Dir+, notes  :: Path Rel Dir+} deriving (Eq, Show, Generic)++instance FromDhall ExportDirs++fromTime :: SR.Time -> Time+fromTime (SR.Time h m s f) = Time h m s f++fromRange :: SR.Range -> Range+fromRange (SR.Range f t) = Range (fromTime f) (fromTime t)++data YouTubeDL m a where+  YouTubeDL' :: Text -> Path Rel File -> Text -> YouTubeDL m ()++makeSem ''YouTubeDL++interpretYouTubeDL :: Member (Embed IO) effs => Sem (YouTubeDL ': effs) a -> Sem effs a+interpretYouTubeDL = interpret \case+  YouTubeDL' x k f -> S.sh $ S.inproc "youtube-dl" [x, "-o", toFilePathText k, "-f", f] mempty++genExcerpts :: Members '[Error SomeException, YouTubeDL, ClipProcess, Reader ExportDirs] m => Path Rel Dir -> ExcerptSpec -> Sem m [RExcerptNote]+genExcerpts dir (ExcerptSpec {..}) = do+  t <- case source of+    YouTubeDL (YDLInfo x y f) -> do+      youTubeDL' x (dir </> y) f+      return (dir </> y)+    LocalVideo x -> return (dir </> x)+  ExportDirs{..} <- ask @ExportDirs+  s' <- either (throwM . SubtitleParseException) return $ A.parseOnly SR.parseSRT subs+  cs <- mapM (parseRelFile . T.unpack . clipf . T.pack . show . SR.index) s'+  es <- mapM (parseRelFile . T.unpack . audiof . T.pack . show . SR.index) s'+  fs <- mapM (parseRelFile . T.unpack . framef . T.pack . show . SR.index) s'+  extractClips t $ zip (fromRange . SR.range <$> s') (clips </$> cs)+  extractAudio t $ zip (fromRange . SR.range <$> s') (audio </$> es)+  forM (zip4 s' cs es fs) $ \(l, c, e, f) -> do+    extractFrames (clips </> c) $ [(Time 0 0 0 0, images </> f)]+    return $ val @"front" (fst . genClozePhrase . SR.dialog $ l)+          :& val @"extra" f+          :& val @"back"  e+          :& RNil++newtype SubtitleParseException = SubtitleParseException String+  deriving (Eq, Show, Generic)++instance Exception SubtitleParseException++instance Member (Error SomeException) r => MonadThrow (Sem r) where+  throwM e = P.throw (toException e)++runExcerptSpecIO :: ResourceDirs -> ExportDirs -> [ExcerptSpec] -> Path Rel File -> IO ()+runExcerptSpecIO (ResourceDirs{..}) x xs out = do+  zs <- sequenceA <$> forM xs \k -> do+    runM . runError . runReader x . interpretYouTubeDL . interpretFFMpegCli $ genExcerpts video k+  case zs of+    Right a -> do+      S.mktree . S.decodeString . toFilePath $ (notes x)+      writeFileUtf8 (toFilePath (notes x </> out)) $ T.intercalate "\n" $ renderExcerptNote <$> join a+    Left (SomeException p) -> throwIO p++genForvos :: MonadThrow m => Locale -> Text -> [Path Rel File] -> [Text] -> m RForvoNote+genForvos (Locale l) x zs as = do+  ys' <- mapM (forvoConvention l) as+  let ys = lpadZipWith (\a _ -> if isJust a then a else Nothing) ys' (replicate 16 ())+  let k = ys !! 0 :*: ys !! 1 :*: ys !! 2 :*: ys !! 3 :*: ys !! 4 :*: ys !! 5 :*: ys !! 6 :*: ys !! 7 :*: ys !! 8 :*: ys !! 9 :*: ys !! 10 :*: ys !! 11 :*: ys !! 12 :*: ys !! 13 :*: ys !! 14 :*: ys !! 15 :*: RNil+  return $ x :*: zs :*: k++runMultiClozeSpecIO :: Locale -> ResourceDirs -> ExportDirs -> [MultiClozeSpec] -> Path Rel File -> IO ()+runMultiClozeSpecIO l _ x xs out = do+  zs <- forM xs \(MultiClozeSpec p f) -> do+    forM p \a -> let (b, c) = genClozePhrase a+                 in  genForvos l b f c+  S.mktree . S.decodeString . toFilePath $ (notes x)+  writeFileUtf8 (toFilePath (notes x </> out)) $ (T.intercalate "\n" $ renderForvoNote <$> join zs)++data ResourceDirs = ResourceDirs {+  audio  :: Path Rel Dir+, video  :: Path Rel Dir+, images :: Path Rel Dir+} deriving (Eq, Show, Generic)++instance FromDhall ResourceDirs++data Deck = Deck {+  resourceDirs :: ResourceDirs+, exportDirs   :: ExportDirs+, parts        :: [Part]+} deriving Generic++data Part = Part {+  outfile :: Path Rel File+, spec   :: Spec+} deriving Generic++instance FromDhall Deck++instance FromDhall Part++data BasicReversedSpec = BasicReversedSpec {+  from       :: VF+, from_extra :: VF+, to         :: VF+, to_extra   :: VF+} deriving (Eq, Show, Generic)++instance FromDhall BasicReversedSpec++instance FromDhall Locale++data ForvoSpec = ForvoSpec {+  locale :: Locale+, spec :: [MultiClozeSpec]+} deriving (Eq, Show, Generic)++instance FromDhall ForvoSpec+data Spec =+    Forvo ForvoSpec+  | Excerpt [ExcerptSpec]+  | BasicReversed [BasicReversedSpec]+  | MinimalReversed [MinimalReversedSpec]+    deriving Generic++instance FromDhall Spec++data WonkyConfig = WonkyConfig {+  decks :: Map Text Deck+} deriving Generic++instance FromDhall WonkyConfig++data MinimalReversedSpec = MinimalReversedSpec {+  from :: VF+, to   :: VF+} deriving (Eq, Show, Generic)++instance FromDhall MinimalReversedSpec++runMinimalReversedIO :: ResourceDirs -> ExportDirs -> [MinimalReversedSpec] -> Path Rel File -> IO ()+runMinimalReversedIO _ x xs out = do+  zs <- forM xs \MinimalReversedSpec{..} -> return $ val @"from" from :& val @"to" to :& RNil+  S.mktree . S.decodeString . toFilePath $ notes x+  writeFileUtf8 (toFilePath (notes x </> out)) $ (T.intercalate "\n" $ renderMinimalNoteVF <$> zs)++runBasicReversedIO :: ResourceDirs -> ExportDirs -> [BasicReversedSpec] -> Path Rel File -> IO ()+runBasicReversedIO ResourceDirs{..} x xs out = do+  zs <- forM xs \BasicReversedSpec{..} -> return $ val @"from" from :& val @"from-extra" from_extra :& val @"to" to :& val @"to-extra" to_extra :& RNil+  S.mktree . S.decodeString . toFilePath $ notes x+  writeFileUtf8 (toFilePath (notes x </> out)) $ T.intercalate "\n" (renderBasicReversedNoteVF <$> zs)++runMakeDeck :: Deck -> IO ()+runMakeDeck Deck{..} = do+  forM_ parts \(Part a p) -> case p of+    Excerpt x -> runExcerptSpecIO resourceDirs exportDirs x a+    Forvo (ForvoSpec l x)   -> runMultiClozeSpecIO l resourceDirs exportDirs x a+    MinimalReversed x -> runMinimalReversedIO resourceDirs exportDirs x a+    BasicReversed x -> runBasicReversedIO resourceDirs exportDirs x a++main :: IO ()+main = do+  x <- input auto "./index.dhall"+  mapM_ runMakeDeck $ fmap snd . Map.toList . decks $ x
+ flashblast.cabal view
@@ -0,0 +1,88 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.34.2.+--+-- see: https://github.com/sol/hpack++name:           flashblast+version:        0.0.1.0+synopsis:       Generate lanuage learning flashcards from video.+author:         Daniel Firth+maintainer:     dan.firth@homotopic.tech+copyright:      2020 Daniel Firth+license:        MIT+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    README.md+    ChangeLog.md++source-repository head+  type: git+  location: https://gitlab.com/homotopic-tech/flashblast++library+  exposed-modules:+      FlashBlast.AnkiDB+      FlashBlast.ClozeParse+      FlashBlast.Conventions+  other-modules:+      Paths_flashblast+  hs-source-dirs:+      src+  default-extensions: BangPatterns BinaryLiterals BlockArguments ConstraintKinds DataKinds DefaultSignatures DeriveDataTypeable DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable DerivingVia DoAndIfThenElse EmptyDataDecls ExistentialQuantification FlexibleContexts FlexibleInstances FunctionalDependencies GADTs GeneralizedNewtypeDeriving InstanceSigs KindSignatures LambdaCase MultiParamTypeClasses MultiWayIf NamedFieldPuns NoImplicitPrelude OverloadedStrings PartialTypeSignatures PatternGuards PatternSynonyms PolyKinds RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving TupleSections TypeApplications TypeFamilies TypeOperators TypeSynonymInstances ViewPatterns+  ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints+  build-depends:+      attoparsec+    , base >=4.7 && <5+    , composite-base+    , dhall+    , formatting+    , lucid+    , megaparsec+    , path+    , path-dhall-instance+    , path-utils+    , polysemy+    , polysemy-video+    , replace-megaparsec+    , rio+    , semialign+    , subtitleParser+    , these+    , turtle+    , unliftio-path+    , vinyl+  default-language: Haskell2010++executable flashblast+  main-is: Main.hs+  other-modules:+      Paths_flashblast+  hs-source-dirs:+      app+  default-extensions: BangPatterns BinaryLiterals BlockArguments ConstraintKinds DataKinds DefaultSignatures DeriveDataTypeable DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable DerivingVia DoAndIfThenElse EmptyDataDecls ExistentialQuantification FlexibleContexts FlexibleInstances FunctionalDependencies GADTs GeneralizedNewtypeDeriving InstanceSigs KindSignatures LambdaCase MultiParamTypeClasses MultiWayIf NamedFieldPuns NoImplicitPrelude OverloadedStrings PartialTypeSignatures PatternGuards PatternSynonyms PolyKinds RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving TupleSections TypeApplications TypeFamilies TypeOperators TypeSynonymInstances ViewPatterns+  ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      attoparsec+    , base >=4.7 && <5+    , composite-base+    , dhall+    , flashblast+    , formatting+    , lucid+    , megaparsec+    , path+    , path-dhall-instance+    , path-utils+    , polysemy+    , polysemy-video+    , replace-megaparsec+    , rio+    , semialign+    , subtitleParser+    , these+    , turtle+    , unliftio-path+    , vinyl+  default-language: Haskell2010
+ src/FlashBlast/AnkiDB.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE PolyKinds #-}+module FlashBlast.AnkiDB where++import Polysemy+import Polysemy.Reader+import RIO hiding (Reader, asks)+import UnliftIO.Path.Directory+import Path++data AnkiDB m a where+  CopyToCollections :: [Path Rel File] -> AnkiDB m ()++makeSem ''AnkiDB++newtype UserProfile = UserProfile { unUserProfile :: Path Abs Dir }++interpretAnkiDBIO :: (Member (Embed IO) effs,+                      Member (Reader UserProfile) effs) => Sem (AnkiDB ': effs) a -> Sem effs a+interpretAnkiDBIO = interpret $ \case+    CopyToCollections xs -> forM_ xs $ \x -> do+                               f <- asks unUserProfile+                               copyFile x (f </> $(mkRelDir "collections.media") </> filename x)
+ src/FlashBlast/ClozeParse.hs view
@@ -0,0 +1,22 @@+module FlashBlast.ClozeParse where++import RIO hiding (many)+import RIO.State+import qualified RIO.Text as T+import Replace.Megaparsec+import Text.Megaparsec hiding (State)+import Text.Megaparsec.Char++bracevar :: ParsecT Void Text m Text+bracevar = between (string "{{") (string "}}") (T.pack <$> many (alphaNumChar <|> spaceChar <|> char '\''))++addClozeNumbers :: Text -> State Int Text+addClozeNumbers x = do+        i <- get+        let i' = i+1+        put i'+        pure $ "{{c" <> T.pack (show i') <> "::" <> x <> "}}"++genClozePhrase :: Text -> (Text, [Text])+genClozePhrase x = ( flip evalState 0 . streamEditT bracevar addClozeNumbers $ x+                   , fmap snd . rights . splitCap (match bracevar) $ x)
+ src/FlashBlast/Conventions.hs view
@@ -0,0 +1,92 @@+{-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}+module FlashBlast.Conventions where++import Dhall hiding (maybe)+import Composite.Record+import Composite.TH+import Formatting+import qualified  RIO.Text as T+import qualified RIO.Text.Lazy as LT+import qualified RIO.Text.Partial as T+import RIO+import Path+import Path.Dhall()+import Path.Utils+import Lucid++data VF = Empty | Raw Text | Images [Path Rel File] | Audio (Path Rel File)+  deriving (Eq, Show ,Generic)++instance FromDhall VF++withLensesAndProxies [d|+  type FFront a     = "front" :-> a+  type FExtra a     = "extra" :-> a+  type FBack a      = "back"  :-> a+  type FFrom a      = "from" :-> a+  type FFromExtra a = "from-extra" :-> a+  type FTo a        = "to" :-> a+  type FToExtra a   = "to-extra" :-> a+  type FAudio1      = "audio1" :-> Maybe (Path Rel File)+  type FAudio2      = "audio2" :-> Maybe (Path Rel File)+  type FAudio3      = "audio3" :-> Maybe (Path Rel File)+  type FAudio4      = "audio4" :-> Maybe (Path Rel File)+  type FAudio5      = "audio5" :-> Maybe (Path Rel File)+  type FAudio6      = "audio6" :-> Maybe (Path Rel File)+  type FAudio7      = "audio7" :-> Maybe (Path Rel File)+  type FAudio8      = "audio8" :-> Maybe (Path Rel File)+  type FAudio9      = "audio9" :-> Maybe (Path Rel File)+  type FAudio10     = "audio10" :-> Maybe (Path Rel File)+  type FAudio11     = "audio11" :-> Maybe (Path Rel File)+  type FAudio12     = "audio12" :-> Maybe (Path Rel File)+  type FAudio13     = "audio13" :-> Maybe (Path Rel File)+  type FAudio14     = "audio14" :-> Maybe (Path Rel File)+  type FAudio15     = "audio15" :-> Maybe (Path Rel File)+  type FAudio16     = "audio16" :-> Maybe (Path Rel File)+  |]++type RBasicNote a b c = Record (FFront a : FExtra b : FBack c : '[])++type RBasicReversedNote a b c d = Record (FFrom a : FFromExtra b : FTo c : FToExtra d : '[])++type RMinimalNote a b = Record (FFrom a : FTo b : '[])++type RMultiAudioNote a b = Record (FFront a : FExtra b : FAudio1 : FAudio2 : FAudio3 : FAudio4 : FAudio5 : FAudio6 : FAudio7 : FAudio8 : FAudio9 : FAudio10 : FAudio11 : FAudio12 : FAudio13 : FAudio14 : FAudio15 : FAudio16 : '[])++type RExcerptNote = RBasicNote Text (Path Rel File) (Path Rel File)++type RForvoNote = RMultiAudioNote Text [Path Rel File]++type RMinimalNoteVF = RMinimalNote VF VF++type RBasicReversedNoteVF = RBasicReversedNote VF VF VF VF++forvoConvention :: MonadThrow m => Text -> Text -> m (Path Rel File)+forvoConvention locale word = parseRelFile . T.unpack $ sformat ("pronunciation_" % stext % "_" % stext % ".mp3") locale (T.replace " " "_" (T.toLower word))++ungroundedImage :: Path Rel File -> Html ()+ungroundedImage x = img_ [src_ $ toFilePathText x]++soundEmbed :: Path Rel File -> Text+soundEmbed = sformat ("[sound:" % stext % "]") . toFilePathText++-- TODO: do this as an interpretation+renderExcerptNote :: RExcerptNote -> Text+renderExcerptNote (a :*: b :*: c :*: RNil) = T.intercalate "\t" [a, LT.toStrict $ renderText $ ungroundedImage (filename b), soundEmbed c]++renderForvoNote :: RForvoNote -> Text+renderForvoNote (a :*: b :*: c :*: d :*: e :*: f :*: g :*: h :*: i :*: j :*: k :*: l :*: m :*: n :*: o :*: p :*: q :*: r :*: RNil)+  = T.intercalate "\t" $ [a, T.intercalate "\n" (LT.toStrict . renderText . ungroundedImage . filename <$> b)] ++ fmap (maybe "" soundEmbed) [c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r]++renderMinimalNoteVF :: RMinimalNoteVF -> Text+renderMinimalNoteVF (a :*: b :*: RNil) = T.intercalate "\t" $ renderVF <$> [a, b]++renderBasicReversedNoteVF :: RBasicReversedNoteVF -> Text+renderBasicReversedNoteVF (a :*: b :*: c :*: d :*: RNil) = T.intercalate "\t" $ renderVF <$> [a,b,c,d]++renderVF :: VF -> Text+renderVF Empty = ""+renderVF (Raw x) = x+renderVF (Images x) = T.intercalate "\n" $ LT.toStrict . renderText . ungroundedImage <$> x+renderVF (Audio x) = soundEmbed x