-- Copyright 2013 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

-- | Tiny program to generate the cached parts of instrument db.  All it does
-- is call 'Instrument.make_dbs', which will dispatch to every synth that
-- wants to save an instrument db cache.
--
-- You can pass synth names to just generate that synth's db.
module Instrument.MakeDb where
import qualified Data.Text.IO as Text.IO
import qualified System.Environment as Environment

import qualified App.LoadInstruments as LoadInstruments
import qualified App.Path as Path
import qualified Cmd.Instrument.MidiInst as MidiInst
import qualified Instrument.InstT as InstT

import Global


main :: IO ()
main :: IO ()
main = do
    [Text]
db_names <- forall a b. (a -> b) -> [a] -> [b]
map String -> Text
txt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [String]
Environment.getArgs
    AppDir
app_dir <- IO AppDir
Path.get_app_dir
    case [Text]
db_names of
        [] -> forall a. AppDir -> [(Text, (MakeDb, a))] -> IO ()
make AppDir
app_dir [(Text, (MakeDb, Load))]
LoadInstruments.all_loads
        [Text]
_ -> do
            let makes :: [Maybe (MakeDb, Load)]
makes = forall a b. (a -> b) -> [a] -> [b]
map (forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup` [(Text, (MakeDb, Load))]
LoadInstruments.all_loads) [Text]
db_names
                not_found :: [Text]
not_found = [Text
name | (Text
name, Maybe (MakeDb, Load)
Nothing) <- forall a b. [a] -> [b] -> [(a, b)]
zip [Text]
db_names [Maybe (MakeDb, Load)]
makes]
                found :: [(Text, (MakeDb, Load))]
found = [(Text
name, (MakeDb, Load)
make) | (Text
name, Just (MakeDb, Load)
make) <- forall a b. [a] -> [b] -> [(a, b)]
zip [Text]
db_names [Maybe (MakeDb, Load)]
makes]
            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
not_found) forall a b. (a -> b) -> a -> b
$
                forall (m :: * -> *) a. (Stack, MonadIO m) => Text -> m a
errorIO forall a b. (a -> b) -> a -> b
$ Text
"dbs not found: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
showt [Text]
not_found
            forall a. AppDir -> [(Text, (MakeDb, a))] -> IO ()
make AppDir
app_dir [(Text, (MakeDb, Load))]
found

make :: Path.AppDir -> [(InstT.SynthName, (MidiInst.MakeDb, a))] -> IO ()
make :: forall a. AppDir -> [(Text, (MakeDb, a))] -> IO ()
make AppDir
app_dir = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall a b. (a -> b) -> a -> b
$ \(Text
name, (MakeDb
make, a
_)) -> do
    Text -> IO ()
Text.IO.putStrLn forall a b. (a -> b) -> a -> b
$ Text
"-------- db: " forall a. Semigroup a => a -> a -> a
<> Text
name
    MakeDb
make AppDir
app_dir