{-# LANGUAGE DataKinds        #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators    #-}
{-# LANGUAGE DeriveAnyClass #-}

-- | This module defines which options exists, and provides
--   functions for parsing cli options.
module Cut.Options
  ( parseProgram
  , specifyTracks
  , getOutFileName
  -- * Program options
  , ProgramOptions(..)
  , gnerate_sub_prism
  , listen_cut_prism
  -- * fileio, deal with input output files
  , FileIO
  , lc_fileio
  , in_file
  , out_file
  , work_dir
  -- * listen cut, options for video editing by audio
  , ListenCutOptionsT
  , ListenCutOptions
  , silent_treshold
  , detect_margin
  , voice_track
  , music_track
  , silent_duration
  , cut_noise
  , voice_track_map
  -- * input source prisms
  , InputSource
  , input_src_remote
  , input_src_local_file
  -- * defaults
  , simpleOptions
  )
where

import           Control.Lens hiding (argument)
import           Data.Generics.Product.Fields
import           Data.Generics.Sum
import qualified Data.Text                    as Text
import           Data.Text.Lens
import           GHC.Generics                 hiding (to)
import           Options.Applicative
import Network.URI

simpleFileIO :: (FileIO InputSource)
simpleFileIO :: FileIO InputSource
simpleFileIO = FileIO :: forall a. a -> FilePath -> Maybe FilePath -> FileIO a
FileIO  { fi_inFile :: InputSource
fi_inFile         = FilePath -> InputSource
LocalFile "in.mkv"                      , fi_outFile :: FilePath
fi_outFile        = "out.mkv"
                       , fi_workDir :: Maybe FilePath
fi_workDir        = Maybe FilePath
forall a. Maybe a
Nothing
                        }

-- type Lens s t a b = forall f. Functor f => (a -> f b) -> s -> f t
in_file :: Lens (FileIO a) (FileIO b) a b
in_file :: (a -> f b) -> FileIO a -> f (FileIO b)
in_file = forall s t a b. HasField "fi_inFile" s t a b => Lens s t a b
forall (field :: Symbol) s t a b.
HasField field s t a b =>
Lens s t a b
field @"fi_inFile"

out_file :: Lens' (FileIO a) FilePath
out_file :: (FilePath -> f FilePath) -> FileIO a -> f (FileIO a)
out_file = forall s t a b. HasField "fi_outFile" s t a b => Lens s t a b
forall (field :: Symbol) s t a b.
HasField field s t a b =>
Lens s t a b
field @"fi_outFile"

work_dir :: Lens' (FileIO a) (Maybe FilePath)
work_dir :: (Maybe FilePath -> f (Maybe FilePath)) -> FileIO a -> f (FileIO a)
work_dir = forall s t a b. HasField "fi_workDir" s t a b => Lens s t a b
forall (field :: Symbol) s t a b.
HasField field s t a b =>
Lens s t a b
field @"fi_workDir"

simpleOptions :: ListenCutOptionsT InputSource
simpleOptions :: ListenCutOptionsT InputSource
simpleOptions = ListenCutOptions :: forall a.
FileIO a
-> Maybe Double
-> Maybe Double
-> Maybe Double
-> Maybe Int
-> Maybe Int
-> Bool
-> ListenCutOptionsT a
ListenCutOptions
                        { lc_fileIO :: FileIO InputSource
lc_fileIO = FileIO InputSource
simpleFileIO
                        , lc_silentTreshold :: Maybe Double
lc_silentTreshold = Tagged Double (Identity Double)
-> Tagged (Maybe Double) (Identity (Maybe Double))
forall a b. Prism (Maybe a) (Maybe b) a b
_Just (Tagged Double (Identity Double)
 -> Tagged (Maybe Double) (Identity (Maybe Double)))
-> Double -> Maybe Double
forall t b. AReview t b -> b -> t
# Double
def_silent
                        , lc_detectMargin :: Maybe Double
lc_detectMargin   = Tagged Double (Identity Double)
-> Tagged (Maybe Double) (Identity (Maybe Double))
forall a b. Prism (Maybe a) (Maybe b) a b
_Just (Tagged Double (Identity Double)
 -> Tagged (Maybe Double) (Identity (Maybe Double)))
-> Double -> Maybe Double
forall t b. AReview t b -> b -> t
# Double
def_detect_margin
                        , lc_voiceTrack :: Maybe Int
lc_voiceTrack     = Tagged Int (Identity Int)
-> Tagged (Maybe Int) (Identity (Maybe Int))
forall a b. Prism (Maybe a) (Maybe b) a b
_Just (Tagged Int (Identity Int)
 -> Tagged (Maybe Int) (Identity (Maybe Int)))
-> Int -> Maybe Int
forall t b. AReview t b -> b -> t
# Int
def_voice_track
                        , lc_musicTrack :: Maybe Int
lc_musicTrack     = Maybe Int
forall a. Maybe a
Nothing
                        , lc_silentDuration :: Maybe Double
lc_silentDuration = Tagged Double (Identity Double)
-> Tagged (Maybe Double) (Identity (Maybe Double))
forall a b. Prism (Maybe a) (Maybe b) a b
_Just (Tagged Double (Identity Double)
 -> Tagged (Maybe Double) (Identity (Maybe Double)))
-> Double -> Maybe Double
forall t b. AReview t b -> b -> t
# Double
def_duration
                        , lc_cutNoise :: Bool
lc_cutNoise       = Bool
def_cut_noise
                        }

getOutFileName :: ListenCutOptionsT a -> FilePath
getOutFileName :: ListenCutOptionsT a -> FilePath
getOutFileName = FilePath -> FilePath
forall a. [a] -> [a]
reverse (FilePath -> FilePath)
-> (ListenCutOptionsT a -> FilePath)
-> ListenCutOptionsT a
-> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
takeWhile ('/' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=) (FilePath -> FilePath)
-> (ListenCutOptionsT a -> FilePath)
-> ListenCutOptionsT a
-> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
forall a. [a] -> [a]
reverse (FilePath -> FilePath)
-> (ListenCutOptionsT a -> FilePath)
-> ListenCutOptionsT a
-> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting FilePath (ListenCutOptionsT a) FilePath
-> ListenCutOptionsT a -> FilePath
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((FileIO a -> Const FilePath (FileIO a))
-> ListenCutOptionsT a -> Const FilePath (ListenCutOptionsT a)
forall a b.
Lens
  (ListenCutOptionsT a) (ListenCutOptionsT b) (FileIO a) (FileIO b)
lc_fileio ((FileIO a -> Const FilePath (FileIO a))
 -> ListenCutOptionsT a -> Const FilePath (ListenCutOptionsT a))
-> ((FilePath -> Const FilePath FilePath)
    -> FileIO a -> Const FilePath (FileIO a))
-> Getting FilePath (ListenCutOptionsT a) FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> Const FilePath FilePath)
-> FileIO a -> Const FilePath (FileIO a)
forall a. Lens' (FileIO a) FilePath
out_file)

-- | Deals with having an input file and a target output file
data FileIO a = FileIO
              { FileIO a -> a
fi_inFile  :: a
              , FileIO a -> FilePath
fi_outFile :: FilePath
              , FileIO a -> Maybe FilePath
fi_workDir :: Maybe FilePath -- ^ for consistency (or debugging) we may want to specify this.
              }
  deriving (Int -> FileIO a -> FilePath -> FilePath
[FileIO a] -> FilePath -> FilePath
FileIO a -> FilePath
(Int -> FileIO a -> FilePath -> FilePath)
-> (FileIO a -> FilePath)
-> ([FileIO a] -> FilePath -> FilePath)
-> Show (FileIO a)
forall a. Show a => Int -> FileIO a -> FilePath -> FilePath
forall a. Show a => [FileIO a] -> FilePath -> FilePath
forall a. Show a => FileIO a -> FilePath
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [FileIO a] -> FilePath -> FilePath
$cshowList :: forall a. Show a => [FileIO a] -> FilePath -> FilePath
show :: FileIO a -> FilePath
$cshow :: forall a. Show a => FileIO a -> FilePath
showsPrec :: Int -> FileIO a -> FilePath -> FilePath
$cshowsPrec :: forall a. Show a => Int -> FileIO a -> FilePath -> FilePath
Show, (forall x. FileIO a -> Rep (FileIO a) x)
-> (forall x. Rep (FileIO a) x -> FileIO a) -> Generic (FileIO a)
forall x. Rep (FileIO a) x -> FileIO a
forall x. FileIO a -> Rep (FileIO a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (FileIO a) x -> FileIO a
forall a x. FileIO a -> Rep (FileIO a) x
$cto :: forall a x. Rep (FileIO a) x -> FileIO a
$cfrom :: forall a x. FileIO a -> Rep (FileIO a) x
Generic)

type ListenCutOptions = ListenCutOptionsT FilePath

-- | Cut out by listening to sound options
data ListenCutOptionsT a = ListenCutOptions
                { ListenCutOptionsT a -> FileIO a
lc_fileIO         :: FileIO a
                , ListenCutOptionsT a -> Maybe Double
lc_silentTreshold :: Maybe Double
                , ListenCutOptionsT a -> Maybe Double
lc_silentDuration :: Maybe Double
                , ListenCutOptionsT a -> Maybe Double
lc_detectMargin   :: Maybe Double
                , ListenCutOptionsT a -> Maybe Int
lc_voiceTrack     :: Maybe Int
                , ListenCutOptionsT a -> Maybe Int
lc_musicTrack     :: Maybe Int
                , ListenCutOptionsT a -> Bool
lc_cutNoise       :: Bool
                }
  deriving (Int -> ListenCutOptionsT a -> FilePath -> FilePath
[ListenCutOptionsT a] -> FilePath -> FilePath
ListenCutOptionsT a -> FilePath
(Int -> ListenCutOptionsT a -> FilePath -> FilePath)
-> (ListenCutOptionsT a -> FilePath)
-> ([ListenCutOptionsT a] -> FilePath -> FilePath)
-> Show (ListenCutOptionsT a)
forall a.
Show a =>
Int -> ListenCutOptionsT a -> FilePath -> FilePath
forall a. Show a => [ListenCutOptionsT a] -> FilePath -> FilePath
forall a. Show a => ListenCutOptionsT a -> FilePath
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [ListenCutOptionsT a] -> FilePath -> FilePath
$cshowList :: forall a. Show a => [ListenCutOptionsT a] -> FilePath -> FilePath
show :: ListenCutOptionsT a -> FilePath
$cshow :: forall a. Show a => ListenCutOptionsT a -> FilePath
showsPrec :: Int -> ListenCutOptionsT a -> FilePath -> FilePath
$cshowsPrec :: forall a.
Show a =>
Int -> ListenCutOptionsT a -> FilePath -> FilePath
Show, (forall x. ListenCutOptionsT a -> Rep (ListenCutOptionsT a) x)
-> (forall x. Rep (ListenCutOptionsT a) x -> ListenCutOptionsT a)
-> Generic (ListenCutOptionsT a)
forall x. Rep (ListenCutOptionsT a) x -> ListenCutOptionsT a
forall x. ListenCutOptionsT a -> Rep (ListenCutOptionsT a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (ListenCutOptionsT a) x -> ListenCutOptionsT a
forall a x. ListenCutOptionsT a -> Rep (ListenCutOptionsT a) x
$cto :: forall a x. Rep (ListenCutOptionsT a) x -> ListenCutOptionsT a
$cfrom :: forall a x. ListenCutOptionsT a -> Rep (ListenCutOptionsT a) x
Generic)

data ProgramOptions a = ListenCut (ListenCutOptionsT a)
                    | GenerateSubtitles (FileIO a)
  deriving (Int -> ProgramOptions a -> FilePath -> FilePath
[ProgramOptions a] -> FilePath -> FilePath
ProgramOptions a -> FilePath
(Int -> ProgramOptions a -> FilePath -> FilePath)
-> (ProgramOptions a -> FilePath)
-> ([ProgramOptions a] -> FilePath -> FilePath)
-> Show (ProgramOptions a)
forall a. Show a => Int -> ProgramOptions a -> FilePath -> FilePath
forall a. Show a => [ProgramOptions a] -> FilePath -> FilePath
forall a. Show a => ProgramOptions a -> FilePath
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [ProgramOptions a] -> FilePath -> FilePath
$cshowList :: forall a. Show a => [ProgramOptions a] -> FilePath -> FilePath
show :: ProgramOptions a -> FilePath
$cshow :: forall a. Show a => ProgramOptions a -> FilePath
showsPrec :: Int -> ProgramOptions a -> FilePath -> FilePath
$cshowsPrec :: forall a. Show a => Int -> ProgramOptions a -> FilePath -> FilePath
Show, (forall x. ProgramOptions a -> Rep (ProgramOptions a) x)
-> (forall x. Rep (ProgramOptions a) x -> ProgramOptions a)
-> Generic (ProgramOptions a)
forall x. Rep (ProgramOptions a) x -> ProgramOptions a
forall x. ProgramOptions a -> Rep (ProgramOptions a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (ProgramOptions a) x -> ProgramOptions a
forall a x. ProgramOptions a -> Rep (ProgramOptions a) x
$cto :: forall a x. Rep (ProgramOptions a) x -> ProgramOptions a
$cfrom :: forall a x. ProgramOptions a -> Rep (ProgramOptions a) x
Generic)

listen_cut_prism :: Prism' (ProgramOptions a) (ListenCutOptionsT a)
listen_cut_prism :: p (ListenCutOptionsT a) (f (ListenCutOptionsT a))
-> p (ProgramOptions a) (f (ProgramOptions a))
listen_cut_prism = forall s t a b. AsConstructor "ListenCut" s t a b => Prism s t a b
forall (ctor :: Symbol) s t a b.
AsConstructor ctor s t a b =>
Prism s t a b
_Ctor @"ListenCut"

gnerate_sub_prism :: Prism' (ProgramOptions a) (FileIO a)
gnerate_sub_prism :: p (FileIO a) (f (FileIO a))
-> p (ProgramOptions a) (f (ProgramOptions a))
gnerate_sub_prism = forall s t a b.
AsConstructor "GenerateSubtitles" s t a b =>
Prism s t a b
forall (ctor :: Symbol) s t a b.
AsConstructor ctor s t a b =>
Prism s t a b
_Ctor @"GenerateSubtitles"

def_voice_track :: Int
def_voice_track :: Int
def_voice_track = 1

def_detect_margin :: Double
def_detect_margin :: Double
def_detect_margin = Double
def_duration Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ 2

def_cut_noise :: Bool
def_cut_noise :: Bool
def_cut_noise = Bool
False

def_silent :: Double
def_silent :: Double
def_silent = 0.075

def_duration :: Double
def_duration :: Double
def_duration = 0.5

def_voice :: Int
def_voice :: Int
def_voice = 1

lc_fileio :: Lens (ListenCutOptionsT a) (ListenCutOptionsT b) (FileIO a) (FileIO b)
lc_fileio :: (FileIO a -> f (FileIO b))
-> ListenCutOptionsT a -> f (ListenCutOptionsT b)
lc_fileio = forall s t a b. HasField "lc_fileIO" s t a b => Lens s t a b
forall (field :: Symbol) s t a b.
HasField field s t a b =>
Lens s t a b
field @"lc_fileIO"

detect_margin :: Lens' (ListenCutOptionsT a) Double
detect_margin :: (Double -> f Double)
-> ListenCutOptionsT a -> f (ListenCutOptionsT a)
detect_margin = forall s t a b. HasField "lc_detectMargin" s t a b => Lens s t a b
forall (field :: Symbol) s t a b.
HasField field s t a b =>
Lens s t a b
field @"lc_detectMargin" ((Maybe Double -> f (Maybe Double))
 -> ListenCutOptionsT a -> f (ListenCutOptionsT a))
-> ((Double -> f Double) -> Maybe Double -> f (Maybe Double))
-> (Double -> f Double)
-> ListenCutOptionsT a
-> f (ListenCutOptionsT a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Iso' (Maybe Double) Double
forall a. Eq a => a -> Iso' (Maybe a) a
non Double
def_detect_margin

silent_treshold :: Lens' (ListenCutOptionsT a) Double
silent_treshold :: (Double -> f Double)
-> ListenCutOptionsT a -> f (ListenCutOptionsT a)
silent_treshold = forall s t a b.
HasField "lc_silentTreshold" s t a b =>
Lens s t a b
forall (field :: Symbol) s t a b.
HasField field s t a b =>
Lens s t a b
field @"lc_silentTreshold" ((Maybe Double -> f (Maybe Double))
 -> ListenCutOptionsT a -> f (ListenCutOptionsT a))
-> ((Double -> f Double) -> Maybe Double -> f (Maybe Double))
-> (Double -> f Double)
-> ListenCutOptionsT a
-> f (ListenCutOptionsT a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Iso' (Maybe Double) Double
forall a. Eq a => a -> Iso' (Maybe a) a
non Double
def_silent

silent_duration :: Lens' (ListenCutOptionsT a) Double
silent_duration :: (Double -> f Double)
-> ListenCutOptionsT a -> f (ListenCutOptionsT a)
silent_duration = forall s t a b.
HasField "lc_silentDuration" s t a b =>
Lens s t a b
forall (field :: Symbol) s t a b.
HasField field s t a b =>
Lens s t a b
field @"lc_silentDuration" ((Maybe Double -> f (Maybe Double))
 -> ListenCutOptionsT a -> f (ListenCutOptionsT a))
-> ((Double -> f Double) -> Maybe Double -> f (Maybe Double))
-> (Double -> f Double)
-> ListenCutOptionsT a
-> f (ListenCutOptionsT a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Iso' (Maybe Double) Double
forall a. Eq a => a -> Iso' (Maybe a) a
non Double
def_duration

voice_track :: Lens' (ListenCutOptionsT a) Int
voice_track :: (Int -> f Int) -> ListenCutOptionsT a -> f (ListenCutOptionsT a)
voice_track = forall s t a b. HasField "lc_voiceTrack" s t a b => Lens s t a b
forall (field :: Symbol) s t a b.
HasField field s t a b =>
Lens s t a b
field @"lc_voiceTrack" ((Maybe Int -> f (Maybe Int))
 -> ListenCutOptionsT a -> f (ListenCutOptionsT a))
-> ((Int -> f Int) -> Maybe Int -> f (Maybe Int))
-> (Int -> f Int)
-> ListenCutOptionsT a
-> f (ListenCutOptionsT a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Iso' (Maybe Int) Int
forall a. Eq a => a -> Iso' (Maybe a) a
non Int
def_voice

music_track :: Lens' (ListenCutOptionsT a) (Maybe Int)
music_track :: (Maybe Int -> f (Maybe Int))
-> ListenCutOptionsT a -> f (ListenCutOptionsT a)
music_track = forall s t a b. HasField "lc_musicTrack" s t a b => Lens s t a b
forall (field :: Symbol) s t a b.
HasField field s t a b =>
Lens s t a b
field @"lc_musicTrack"

cut_noise :: Lens' (ListenCutOptionsT a) Bool
cut_noise :: (Bool -> f Bool) -> ListenCutOptionsT a -> f (ListenCutOptionsT a)
cut_noise = forall s t a b. HasField "lc_cutNoise" s t a b => Lens s t a b
forall (field :: Symbol) s t a b.
HasField field s t a b =>
Lens s t a b
field @"lc_cutNoise"

voice_track_map :: (ListenCutOptionsT a) -> Text.Text
voice_track_map :: ListenCutOptionsT a -> Text
voice_track_map = Text -> Text -> Text
forall a. Monoid a => a -> a -> a
mappend "0:" (Text -> Text)
-> (ListenCutOptionsT a -> Text) -> ListenCutOptionsT a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Text (ListenCutOptionsT a) Text
-> ListenCutOptionsT a -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Int -> Const Text Int)
-> ListenCutOptionsT a -> Const Text (ListenCutOptionsT a)
forall a. Lens' (ListenCutOptionsT a) Int
voice_track ((Int -> Const Text Int)
 -> ListenCutOptionsT a -> Const Text (ListenCutOptionsT a))
-> ((Text -> Const Text Text) -> Int -> Const Text Int)
-> Getting Text (ListenCutOptionsT a) Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> FilePath) -> Optic' (->) (Const Text) Int FilePath
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Int -> FilePath
forall a. Show a => a -> FilePath
show Optic' (->) (Const Text) Int FilePath
-> ((Text -> Const Text Text) -> FilePath -> Const Text FilePath)
-> (Text -> Const Text Text)
-> Int
-> Const Text Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const Text Text) -> FilePath -> Const Text FilePath
forall t. IsText t => Iso' FilePath t
packed)

specifyTracks :: (ListenCutOptionsT a) -> [Text.Text]
specifyTracks :: ListenCutOptionsT a -> [Text]
specifyTracks options :: ListenCutOptionsT a
options =
  [ "-map"
  , "0:0"
  , "-map"  -- then copy only the voice track
  , ListenCutOptionsT a -> Text
forall a. ListenCutOptionsT a -> Text
voice_track_map ListenCutOptionsT a
options
  ]

data InputSource = LocalFile FilePath
                 | Remote URI
                 deriving (Int -> InputSource -> FilePath -> FilePath
[InputSource] -> FilePath -> FilePath
InputSource -> FilePath
(Int -> InputSource -> FilePath -> FilePath)
-> (InputSource -> FilePath)
-> ([InputSource] -> FilePath -> FilePath)
-> Show InputSource
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [InputSource] -> FilePath -> FilePath
$cshowList :: [InputSource] -> FilePath -> FilePath
show :: InputSource -> FilePath
$cshow :: InputSource -> FilePath
showsPrec :: Int -> InputSource -> FilePath -> FilePath
$cshowsPrec :: Int -> InputSource -> FilePath -> FilePath
Show, (forall x. InputSource -> Rep InputSource x)
-> (forall x. Rep InputSource x -> InputSource)
-> Generic InputSource
forall x. Rep InputSource x -> InputSource
forall x. InputSource -> Rep InputSource x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep InputSource x -> InputSource
$cfrom :: forall x. InputSource -> Rep InputSource x
Generic)

input_src_local_file :: Prism' InputSource FilePath
input_src_local_file :: p FilePath (f FilePath) -> p InputSource (f InputSource)
input_src_local_file = forall s t a b. AsConstructor "LocalFile" s t a b => Prism s t a b
forall (ctor :: Symbol) s t a b.
AsConstructor ctor s t a b =>
Prism s t a b
_Ctor @"LocalFile"

input_src_remote :: Prism' InputSource URI
input_src_remote :: p URI (f URI) -> p InputSource (f InputSource)
input_src_remote = forall s t a b. AsConstructor "Remote" s t a b => Prism s t a b
forall (ctor :: Symbol) s t a b.
AsConstructor ctor s t a b =>
Prism s t a b
_Ctor @"Remote"

readFileSource :: ReadM InputSource
readFileSource :: ReadM InputSource
readFileSource = (FilePath -> Either FilePath InputSource) -> ReadM InputSource
forall a. (FilePath -> Either FilePath a) -> ReadM a
eitherReader ((FilePath -> Either FilePath InputSource) -> ReadM InputSource)
-> (FilePath -> Either FilePath InputSource) -> ReadM InputSource
forall a b. (a -> b) -> a -> b
$
  \x :: FilePath
x ->
    Either FilePath InputSource
-> (InputSource -> Either FilePath InputSource)
-> Maybe InputSource
-> Either FilePath InputSource
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (FilePath -> Either FilePath InputSource
forall a b. a -> Either a b
Left "unlikely error") InputSource -> Either FilePath InputSource
forall a b. b -> Either a b
Right (Maybe InputSource -> Either FilePath InputSource)
-> Maybe InputSource -> Either FilePath InputSource
forall a b. (a -> b) -> a -> b
$
    (URI -> InputSource
Remote (URI -> InputSource) -> Maybe URI -> Maybe InputSource
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> Maybe URI
parseURI FilePath
x) Maybe InputSource -> Maybe InputSource -> Maybe InputSource
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> InputSource -> Maybe InputSource
forall a. a -> Maybe a
Just (FilePath -> InputSource
LocalFile FilePath
x)

parseFile :: Parser (FileIO InputSource)
parseFile :: Parser (FileIO InputSource)
parseFile = InputSource -> FilePath -> Maybe FilePath -> FileIO InputSource
forall a. a -> FilePath -> Maybe FilePath -> FileIO a
FileIO
    (InputSource -> FilePath -> Maybe FilePath -> FileIO InputSource)
-> Parser InputSource
-> Parser (FilePath -> Maybe FilePath -> FileIO InputSource)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM InputSource
-> Mod ArgumentFields InputSource -> Parser InputSource
forall a. ReadM a -> Mod ArgumentFields a -> Parser a
argument ReadM InputSource
readFileSource (FilePath -> Mod ArgumentFields InputSource
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar "INPUT" Mod ArgumentFields InputSource
-> Mod ArgumentFields InputSource -> Mod ArgumentFields InputSource
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod ArgumentFields InputSource
forall (f :: * -> *) a. FilePath -> Mod f a
help "The input video, either a file or a uri. This program has tested best with the mkv container type, you can use ffmpeg to convert containers, for example \"ffmpeg -i input.mp4 output.mkv\", see https://opensource.com/article/17/6/ffmpeg-convert-media-file-formats")
    Parser (FilePath -> Maybe FilePath -> FileIO InputSource)
-> Parser FilePath -> Parser (Maybe FilePath -> FileIO InputSource)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReadM FilePath -> Mod ArgumentFields FilePath -> Parser FilePath
forall a. ReadM a -> Mod ArgumentFields a -> Parser a
argument ReadM FilePath
forall s. IsString s => ReadM s
str (FilePath -> Mod ArgumentFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar "OUTPUT_FILE" Mod ArgumentFields FilePath
-> Mod ArgumentFields FilePath -> Mod ArgumentFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod ArgumentFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help "The output name without format" Mod ArgumentFields FilePath
-> Mod ArgumentFields FilePath -> Mod ArgumentFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod ArgumentFields FilePath
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value "out.mkv" Mod ArgumentFields FilePath
-> Mod ArgumentFields FilePath -> Mod ArgumentFields FilePath
forall a. Semigroup a => a -> a -> a
<> Mod ArgumentFields FilePath
forall a (f :: * -> *). Show a => Mod f a
showDefault)
    Parser (Maybe FilePath -> FileIO InputSource)
-> Parser (Maybe FilePath) -> Parser (FileIO InputSource)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser FilePath -> Parser (Maybe FilePath)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
          (ReadM FilePath -> Mod OptionFields FilePath -> Parser FilePath
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
            ReadM FilePath
forall s. IsString s => ReadM s
str
            (  FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long "workDir"
            Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help
                 "If specified will use this as temporary directory to store intermeidate files in, good for debugging. Needs to be absolute"
            )
          )

parseProgram :: Parser (ProgramOptions InputSource)
parseProgram :: Parser (ProgramOptions InputSource)
parseProgram =
  Mod CommandFields (ProgramOptions InputSource)
-> Parser (ProgramOptions InputSource)
forall a. Mod CommandFields a -> Parser a
subparser (Mod CommandFields (ProgramOptions InputSource)
 -> Parser (ProgramOptions InputSource))
-> Mod CommandFields (ProgramOptions InputSource)
-> Parser (ProgramOptions InputSource)
forall a b. (a -> b) -> a -> b
$
    FilePath
-> ParserInfo (ProgramOptions InputSource)
-> Mod CommandFields (ProgramOptions InputSource)
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command "listen" (Parser (ProgramOptions InputSource)
-> InfoMod (ProgramOptions InputSource)
-> ParserInfo (ProgramOptions InputSource)
forall a. Parser a -> InfoMod a -> ParserInfo a
info (ListenCutOptionsT InputSource -> ProgramOptions InputSource
forall a. ListenCutOptionsT a -> ProgramOptions a
ListenCut (ListenCutOptionsT InputSource -> ProgramOptions InputSource)
-> Parser (ListenCutOptionsT InputSource)
-> Parser (ProgramOptions InputSource)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (ListenCutOptionsT InputSource)
parseSound) (InfoMod (ProgramOptions InputSource)
 -> ParserInfo (ProgramOptions InputSource))
-> InfoMod (ProgramOptions InputSource)
-> ParserInfo (ProgramOptions InputSource)
forall a b. (a -> b) -> a -> b
$ FilePath -> InfoMod (ProgramOptions InputSource)
forall a. FilePath -> InfoMod a
progDesc "Cut out by listening to sound options. We listen for silences and cut out the parts that are silenced.")
    Mod CommandFields (ProgramOptions InputSource)
-> Mod CommandFields (ProgramOptions InputSource)
-> Mod CommandFields (ProgramOptions InputSource)
forall a. Semigroup a => a -> a -> a
<>
    FilePath
-> ParserInfo (ProgramOptions InputSource)
-> Mod CommandFields (ProgramOptions InputSource)
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command "subtitles" (Parser (ProgramOptions InputSource)
-> InfoMod (ProgramOptions InputSource)
-> ParserInfo (ProgramOptions InputSource)
forall a. Parser a -> InfoMod a -> ParserInfo a
info (FileIO InputSource -> ProgramOptions InputSource
forall a. FileIO a -> ProgramOptions a
GenerateSubtitles (FileIO InputSource -> ProgramOptions InputSource)
-> Parser (FileIO InputSource)
-> Parser (ProgramOptions InputSource)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (FileIO InputSource)
parseFile) (InfoMod (ProgramOptions InputSource)
 -> ParserInfo (ProgramOptions InputSource))
-> InfoMod (ProgramOptions InputSource)
-> ParserInfo (ProgramOptions InputSource)
forall a b. (a -> b) -> a -> b
$ FilePath -> InfoMod (ProgramOptions InputSource)
forall a. FilePath -> InfoMod a
progDesc "Generate subtiles for a video. This is an intermediate (but usefull) feature developed for recognizing human speech vs background noise.")

parseSound :: Parser (ListenCutOptionsT InputSource)
parseSound :: Parser (ListenCutOptionsT InputSource)
parseSound = FileIO InputSource
-> Maybe Double
-> Maybe Double
-> Maybe Double
-> Maybe Int
-> Maybe Int
-> Bool
-> ListenCutOptionsT InputSource
forall a.
FileIO a
-> Maybe Double
-> Maybe Double
-> Maybe Double
-> Maybe Int
-> Maybe Int
-> Bool
-> ListenCutOptionsT a
ListenCutOptions
    (FileIO InputSource
 -> Maybe Double
 -> Maybe Double
 -> Maybe Double
 -> Maybe Int
 -> Maybe Int
 -> Bool
 -> ListenCutOptionsT InputSource)
-> Parser (FileIO InputSource)
-> Parser
     (Maybe Double
      -> Maybe Double
      -> Maybe Double
      -> Maybe Int
      -> Maybe Int
      -> Bool
      -> ListenCutOptionsT InputSource)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (FileIO InputSource)
parseFile
    Parser
  (Maybe Double
   -> Maybe Double
   -> Maybe Double
   -> Maybe Int
   -> Maybe Int
   -> Bool
   -> ListenCutOptionsT InputSource)
-> Parser (Maybe Double)
-> Parser
     (Maybe Double
      -> Maybe Double
      -> Maybe Int
      -> Maybe Int
      -> Bool
      -> ListenCutOptionsT InputSource)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Double -> Parser (Maybe Double)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
          (ReadM Double -> Mod OptionFields Double -> Parser Double
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
            ReadM Double
forall a. Read a => ReadM a
auto
            (  FilePath -> Mod OptionFields Double
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long "silentTreshold"
            Mod OptionFields Double
-> Mod OptionFields Double -> Mod OptionFields Double
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Double
forall (f :: * -> *) a. FilePath -> Mod f a
help
                 "The treshold for determining intersting sections, closer to zero is detects more audio (n: https://ffmpeg.org/ffmpeg-filters.html#silencedetect), you may wish to tweak this variable a bit depending on your mic."
            Mod OptionFields Double
-> Mod OptionFields Double -> Mod OptionFields Double
forall a. Semigroup a => a -> a -> a
<> Double -> Mod OptionFields Double
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Double
def_silent Mod OptionFields Double
-> Mod OptionFields Double -> Mod OptionFields Double
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields Double
forall a (f :: * -> *). Show a => Mod f a
showDefault
            )
          )
    Parser
  (Maybe Double
   -> Maybe Double
   -> Maybe Int
   -> Maybe Int
   -> Bool
   -> ListenCutOptionsT InputSource)
-> Parser (Maybe Double)
-> Parser
     (Maybe Double
      -> Maybe Int -> Maybe Int -> Bool -> ListenCutOptionsT InputSource)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Double -> Parser (Maybe Double)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
          (ReadM Double -> Mod OptionFields Double -> Parser Double
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
            ReadM Double
forall a. Read a => ReadM a
auto
            (  FilePath -> Mod OptionFields Double
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long "silentDuration"
            Mod OptionFields Double
-> Mod OptionFields Double -> Mod OptionFields Double
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Double
forall (f :: * -> *) a. FilePath -> Mod f a
help
                 "The duration before something can be considered a silence (https://ffmpeg.org/ffmpeg-filters.html#silencedetect)"
            Mod OptionFields Double
-> Mod OptionFields Double -> Mod OptionFields Double
forall a. Semigroup a => a -> a -> a
<> Double -> Mod OptionFields Double
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Double
def_duration Mod OptionFields Double
-> Mod OptionFields Double -> Mod OptionFields Double
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields Double
forall a (f :: * -> *). Show a => Mod f a
showDefault
            )
          )
    Parser
  (Maybe Double
   -> Maybe Int -> Maybe Int -> Bool -> ListenCutOptionsT InputSource)
-> Parser (Maybe Double)
-> Parser
     (Maybe Int -> Maybe Int -> Bool -> ListenCutOptionsT InputSource)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Double -> Parser (Maybe Double)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
          (ReadM Double -> Mod OptionFields Double -> Parser Double
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
            ReadM Double
forall a. Read a => ReadM a
auto
            (FilePath -> Mod OptionFields Double
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long "detectMargin" Mod OptionFields Double
-> Mod OptionFields Double -> Mod OptionFields Double
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Double
forall (f :: * -> *) a. FilePath -> Mod f a
help "Margin seconds around detection"
            Mod OptionFields Double
-> Mod OptionFields Double -> Mod OptionFields Double
forall a. Semigroup a => a -> a -> a
<> Double -> Mod OptionFields Double
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Double
def_detect_margin Mod OptionFields Double
-> Mod OptionFields Double -> Mod OptionFields Double
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields Double
forall a (f :: * -> *). Show a => Mod f a
showDefault
            )
          )
    Parser
  (Maybe Int -> Maybe Int -> Bool -> ListenCutOptionsT InputSource)
-> Parser (Maybe Int)
-> Parser (Maybe Int -> Bool -> ListenCutOptionsT InputSource)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Int -> Parser (Maybe Int)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
          (ReadM Int -> Mod OptionFields Int -> Parser Int
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
            ReadM Int
forall a. Read a => ReadM a
auto
            (FilePath -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long "voiceTrack" Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Int
forall (f :: * -> *) a. FilePath -> Mod f a
help "The track to detect the silences upon"
             Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> Int -> Mod OptionFields Int
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Int
def_voice_track Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields Int
forall a (f :: * -> *). Show a => Mod f a
showDefault)
          )
    Parser (Maybe Int -> Bool -> ListenCutOptionsT InputSource)
-> Parser (Maybe Int)
-> Parser (Bool -> ListenCutOptionsT InputSource)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Int -> Parser (Maybe Int)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
          (ReadM Int -> Mod OptionFields Int -> Parser Int
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM Int
forall a. Read a => ReadM a
auto (FilePath -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long "musicTrack" Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Int
forall (f :: * -> *) a. FilePath -> Mod f a
help "The track to integrate"))
    Parser (Bool -> ListenCutOptionsT InputSource)
-> Parser Bool -> Parser (ListenCutOptionsT InputSource)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch
          (FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long "cutNoise" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. FilePath -> Mod f a
help "Do the opposite: Cut noise instead of silence")