-- Copyright 2023 Evan Laforge
-- This program is distributed under the terms of the GNU General Public
-- License 3.0, see COPYING or http://www.gnu.org/licenses/gpl-3.0.txt

-- | Ghci functions for creating sample sets.
module Synth.Sampler.Patch.Lib.Prepare where
import qualified Data.List as List
import qualified System.Directory as Directory
import qualified System.FilePath as FilePath
import           System.FilePath ((</>))

import qualified Text.Read as Read

import qualified Util.Files as Files
import qualified Util.Lists as Lists

import           Global


{-
    Procedure:
    - Rename samples and takes to short names.
    - Record room tone, apply ReaFir in subtract mode to get a denoise profile.
    - Reaper: dynamic split items (d), turn gate threshold down
      shift-up for vertical zoom on waveforms
    - Edit each sample to trim.  Move back attacks a bit since split tends to
      miss them.  Remove bad samples and update varsAt.
    - Fade out ends by select all, F2, set fade out to say 0.5s.
    - Select all, "SWS: create regions for sel items (name by active take)"
    - Verify numbers against permutations count.  Use binary search to find
      mismatches.
    - Select all, then render project regions to $baseDir/$inst/raw
    - Inspect renames, 'relink' renames, inspect output dirs.
-}


baseDir :: FilePath
baseDir :: [Char]
baseDir = [Char]
"/Users/elaforge/Music/mix/sample"

slenthemRelink :: IO ()
slenthemRelink = [Char] -> [Char] -> [Char] -> [([Char], [Char])] -> IO ()
relink ([Char]
baseDir [Char] -> [Char] -> [Char]
</> [Char]
"java/slenthem") [Char]
"raw" [Char]
"samples"
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [Char] -> [[Char]] -> IO [([Char], [Char])]
renames ([Char]
baseDir [Char] -> [Char] -> [Char]
</> [Char]
"java/slenthem/raw") [[Char]]
slenthem

slenthem :: [FilePath]
slenthem :: [[Char]]
slenthem = [[Char]]
opens forall a. [a] -> [a] -> [a]
++ [[Char]]
mutes
    where
    opens :: [[Char]]
opens =
        [ [Char]
"open" [Char] -> [Char] -> [Char]
</> [[Char]] -> [Char]
join [[Char]
p, [Char]
dyn, [Char]
var]
        | [Char]
p <- [[Char]]
pitches
        , [Char]
dyn <- [[Char]]
dynamics
        , [Char]
var <- ([Char], [Char]) -> [[Char]]
varsAt ([Char]
p, [Char]
dyn)
        ]
        where
        varsAt :: ([Char], [Char]) -> [[Char]]
varsAt = Int -> [[Char]]
vars forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
            ([Char]
"26", [Char]
"pp") -> Int
3
            ([Char]
"26", [Char]
"mf") -> Int
5
            ([Char]
"27", [Char]
"ff") -> Int
3
            ([Char], [Char])
_ -> Int
4
    mutes :: [[Char]]
mutes =
        [ [Char]
"mute" [Char] -> [Char] -> [Char]
</> [[Char]] -> [Char]
join [[Char]
p, [Char]
dyn, [Char]
var]
        | [Char]
p <- [[Char]]
pitches
        , [Char]
dyn <- [[Char]]
dynamics
        , [Char]
var <- ([Char], [Char]) -> [[Char]]
varsAt ([Char]
p, [Char]
dyn)
        ]
        where
        varsAt :: ([Char], [Char]) -> [[Char]]
varsAt = Int -> [[Char]]
vars forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
            ([Char]
"25", [Char]
"pp") -> Int
5
            ([Char], [Char])
_ -> Int
6
    pitches :: [[Char]]
pitches = [[Char]
"2" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show Integer
p | Integer
p <- [Integer
1..Integer
7]]

-- genderPanerus =
--     pitches = map (\(o, p) -> show o <> show p) $
--         takeWhile (<= (5, 3)) $ dropWhile (< (2, 6))
--             [(o, p) | o <- [2..5], p <- ps]
--         where ps = [1, 2, 3, 5, 6, 7]

dynamics :: [String]
dynamics :: [[Char]]
dynamics = [[Char]
"pp", [Char]
"mp", [Char]
"mf", [Char]
"ff"]

vars :: Int -> [String]
vars :: Int -> [[Char]]
vars Int
n = forall a b. (a -> b) -> [a] -> [b]
map ((Char
'v':) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show) [Int
1..Int
n]

join :: [String] -> String
join :: [[Char]] -> [Char]
join = (forall a. Semigroup a => a -> a -> a
<> [Char]
".wav") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => a -> [a] -> a
Lists.join [Char]
"-"

-- * check

printNumbers :: Int -> [FilePath] -> IO ()
printNumbers :: Int -> [[Char]] -> IO ()
printNumbers Int
level [[Char]]
fnames = do
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ([Char] -> IO ()
putStrLn forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, [Char]) -> [Char]
fmt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> a
head) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall key a. Eq key => (a -> key) -> [a] -> [[a]]
Lists.groupAdjacent ([Char] -> [[Char]]
key forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd)
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..] forall a b. (a -> b) -> a -> b
$ [[Char]]
fnames
    forall a. Show a => a -> IO ()
print (forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Char]]
fnames)
    where
    fmt :: (Int, [Char]) -> [Char]
fmt (Int
n :: Int, [Char]
fname) = forall a. Show a => a -> [Char]
show Int
n forall a. Semigroup a => a -> a -> a
<> [Char]
" - " forall a. Semigroup a => a -> a -> a
<> [Char]
fname
    key :: [Char] -> [[Char]]
key = forall a. Int -> [a] -> [a]
take Int
level forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [[a]]
Lists.splitBefore (\Char
c -> Char
c forall a. Eq a => a -> a -> Bool
== Char
'/' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'-')

-- * filesystem

-- | Do the given renames with symlinks links into a different directory, so
-- it's non-destructive.
relink :: FilePath -> FilePath -> FilePath -> [(FilePath, FilePath)] -> IO ()
relink :: [Char] -> [Char] -> [Char] -> [([Char], [Char])] -> IO ()
relink [Char]
baseDir [Char]
fromDir [Char]
toDir = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ([Char], [Char]) -> IO ()
link
    where
    link :: ([Char], [Char]) -> IO ()
link ([Char]
old, [Char]
new) = [Char] -> [Char] -> IO ()
Directory.createFileLink ([Char]
baseDir [Char] -> [Char] -> [Char]
</> [Char]
fromDir [Char] -> [Char] -> [Char]
</> [Char]
old)
        ([Char]
baseDir [Char] -> [Char] -> [Char]
</> [Char]
toDir [Char] -> [Char] -> [Char]
</> [Char]
new)

-- | Generate renames list, matching names against dir contents.
renames :: FilePath -> [FilePath] -> IO [(FilePath, FilePath)]
renames :: [Char] -> [[Char]] -> IO [([Char], [Char])]
renames [Char]
dir [[Char]]
groups = do
    [[Char]]
samples <- [Char] -> IO [[Char]]
listSampleDir [Char]
dir
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Char]]
groups forall a. Eq a => a -> a -> Bool
== forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Char]]
samples) forall a b. (a -> b) -> a -> b
$
        [Char] -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ [Char]
"expected " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show (forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Char]]
groups)
            forall a. Semigroup a => a -> a -> a
<> [Char]
" samples, but found " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show (forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Char]]
samples)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip (forall a b. (a -> b) -> [a] -> [b]
map [Char] -> [Char]
FilePath.takeFileName [[Char]]
samples) [[Char]]
groups

listSampleDir :: FilePath -> IO [FilePath]
listSampleDir :: [Char] -> IO [[Char]]
listSampleDir [Char]
dir =
    forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => (a -> k) -> [a] -> [a]
Lists.sortOn forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a k. (a -> Maybe k) -> [a] -> [(k, a)]
Lists.keyOnJust [Char] -> Maybe Int
sampleNumber
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter ([Char]
".wav" `List.isSuffixOf`) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO [[Char]]
Files.list [Char]
dir

sampleNumber :: FilePath -> Maybe Int
sampleNumber :: [Char] -> Maybe Int
sampleNumber =
    forall a. Read a => [Char] -> Maybe a
Read.readMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
Lists.takeWhileEnd (forall a. Eq a => a -> a -> Bool
/=Char
'-') forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
FilePath.dropExtension