Commit 9244d371 authored by Daniel Firth's avatar Daniel Firth
Browse files

initial commit - v0.0.1.0

parents
.stack-work/
*~
image: nixos/nix:latest
before_script:
- export LC_ALL=C.UTF-8
- nix-channel --add https://nixos.org/channels/nixpkgs-unstable nixpkgs
- nix-channel --update
- nix-env -iA nixpkgs.stack
- nix-env -iA nixpkgs.hlint
stages:
- build
build:
stage: build
script:
- stack --nix build
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.
# danki - Command line application for creating anki flashcards.
Danki is a command line application for creating anki flashcards from a dhall config.
This is in early stages and not very sophisticated, but you can try it out using the [sample decks](https://gitlab.com/homotopic-tech/danki-sample-decks) to get working output.
# Install
```
stack install danki
```
# Run
cd to the sample decks repository and run
```
danki
```
{-# 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
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
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/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
name: flashblast
version: 0.0.1.0
git: https://gitlab.com/flashblast
license: MIT
author: "Daniel Firth"
maintainer: "dan.firth@homotopic.tech"
copyright: "2020 Daniel Firth"
extra-source-files:
- README.md
- ChangeLog.md
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
dependencies:
- attoparsec
- base >= 4.7 && < 5
- composite-base
- dhall
- formatting
- lucid
- megaparsec
- replace-megaparsec
- path
- path-dhall-instance
- path-utils
- polysemy
- polysemy-video
- rio
- semialign
- subtitleParser
- these
- turtle
- unliftio-path
- vinyl
library:
source-dirs: src
executables:
flashblast:
main: Main.hs
source-dirs: app
ghc-options:
- -threaded
- -rtsopts
- -with-rtsopts=-N
dependencies:
- flashblast
ghc-options:
- -Wall
- -Wcompat
- -Wincomplete-record-updates
- -Wincomplete-uni-patterns
- -Wredundant-constraints
{-# 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)
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)
{-# 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
resolver: nightly-2020-09-29
packages:
- .
extra-deps:
- compact-0.2.0.0
- polysemy-plugin-0.2.5.1
- subtitleParser-0.5
- replace-megaparsec-1.4.3.0
- path-dhall-instance-0.2.0.0
- path-utils-0.1.1.0
- unliftio-path-0.0.2.0
- polysemy-video-0.1.0.1
nix:
packages: [zlib, libffi, ffmpeg, pkg-config]
# This file was autogenerated by Stack.
# You should not edit this file by hand.
# For more information, please see the documentation at:
# https://docs.haskellstack.org/en/stable/lock_files
packages:
- completed:
hackage: compact-0.2.0.0@sha256:9c5785bdc178ea6cf8f514ad35a78c64220e3cdb22216534e4cf496765551c7e,2345
pantry-tree:
size: 546
sha256: 6f7da573fbcddc109e1521edc07f1b34d7506473a3930074453e829daf901d71
original:
hackage: compact-0.2.0.0
- completed:
hackage: polysemy-plugin-0.2.5.1@sha256:61c6c0aad2852377aa5d5a8f9639a437905e3a6f0e2a99a41e96fb231dc86836,2952
pantry-tree:
size: 1232
sha256: 9720d9a1675c7ac3e2635b8c9f002f7ab0764eb60738a3405603cb33bdffc493
original:
hackage: polysemy-plugin-0.2.5.1
- completed:
hackage: subtitleParser-0.5@sha256:e01dd1cac3434c16d0bdf33a3c6ce1132e76ce69134d24d5f2908a7215c0c30e,1344
pantry-tree:
size: 743
sha256: 3d0fdac25f09e50bd3e12bbcce475aace2e3fd13f878754cf6fd11e5d29ee4e3
original:
hackage: subtitleParser-0.5
- completed:
hackage: replace-megaparsec-1.4.3.0@sha256:7fe9c1384093bbb1cfb3db426b3f408c080bdd9955e528d48bcb91de350627cb,2462
pantry-tree:
size: 680
sha256: 34926344c69b252144403161016f70f26e9d0fe7d0b04c13771b33e8b1e4ac9d
original:
hackage: replace-megaparsec-1.4.3.0
- completed:
hackage: path-dhall-instance-0.2.0.0@sha256:11dc19442809a7f4e84b6c285bdb529e437ba85d45d5bdc49abb5db2e8cfd879,803
pantry-tree:
size: 274
sha256: a3acf446887df4a67a01ece97d38cd9148c41af549fe1e501af25d1a5e4e90b2
original:
hackage: path-dhall-instance-0.2.0.0
- completed:
hackage: path-utils-0.1.1.0@sha256:e2c9931774eaf808fd58aa37801d4280c9b6eff075b4108d06ef78d88c8218d1,1022
pantry-tree:
size: 265
sha256: 5f53098c499b7e7bea9269ab28debe21552baa13fc2c8e30d9d4db80fdde36b5
original:
hackage: path-utils-0.1.1.0
- completed:
hackage: unliftio-path-0.0.2.0@sha256:cf4b02640b99831004853e8fc9f9ff922514d08a24ea36e09e8e7a77b250bc80,787
pantry-tree:
size: 281
sha256: 96fc899a5d4935c5eb8075e5f65a2c5eb046282ad9aac0fadcb3cbad9bdca164
original:
hackage: unliftio-path-0.0.2.0
- completed:
hackage: polysemy-video-0.1.0.1@sha256:9e7ba38a6839d60d9b13f9dfe4fe83b32b947f1c7c3c645eed9f3f95b2e10efb,991
pantry-tree:
size: 272
sha256: 24b13d6347bbdd7de55c54be2b8d17285b6359b97d7a9a3397a3c96e1404b4c1
original:
hackage: polysemy-video-0.1.0.1
snapshots:
- completed:
size: 533430
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/nightly/2020/9/29.yaml
sha256: 257d950f082432a4807a9f18fb35c4712470cd534d3e45af9732753e30b967d3
original: nightly-2020-09-29
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment