{-# LANGUAGE DeriveAnyClass #-}

-- | Utility code to gather MIDI system information.
module Sound.RtMidi.Report
  ( ApiReport (..)
  , Report (..)
  , buildApiReport
  , buildCustomReport
  , buildReport
  )
where

import Control.DeepSeq (NFData)
import Data.List (nub)
import GHC.Generics (Generic)
import Sound.RtMidi
  ( Api
  , apiDisplayName
  , apiName
  , compiledApis
  , createInput
  , createOutput
  , currentApi
  , defaultInput
  , defaultOutput
  , listPorts
  )

-- | MIDI system information specific to a particular API.
data ApiReport = ApiReport
  { ApiReport -> Api
apiRepApi :: !Api
  , ApiReport -> String
apiRepName :: !String
  , ApiReport -> String
apiRepDisplayName :: !String
  , ApiReport -> [(Int, String)]
apiInPorts :: ![(Int, String)]
  , ApiReport -> [(Int, String)]
apiOutPorts :: ![(Int, String)]
  }
  deriving stock (ApiReport -> ApiReport -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiReport -> ApiReport -> Bool
$c/= :: ApiReport -> ApiReport -> Bool
== :: ApiReport -> ApiReport -> Bool
$c== :: ApiReport -> ApiReport -> Bool
Eq, Int -> ApiReport -> ShowS
[ApiReport] -> ShowS
ApiReport -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiReport] -> ShowS
$cshowList :: [ApiReport] -> ShowS
show :: ApiReport -> String
$cshow :: ApiReport -> String
showsPrec :: Int -> ApiReport -> ShowS
$cshowsPrec :: Int -> ApiReport -> ShowS
Show, forall x. Rep ApiReport x -> ApiReport
forall x. ApiReport -> Rep ApiReport x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ApiReport x -> ApiReport
$cfrom :: forall x. ApiReport -> Rep ApiReport x
Generic)
  deriving anyclass (ApiReport -> ()
forall a. (a -> ()) -> NFData a
rnf :: ApiReport -> ()
$crnf :: ApiReport -> ()
NFData)

-- | MIDI system information for any number of APIs.
data Report = Report
  { Report -> Api
defaultInApi :: !Api
  , Report -> Api
defaultOutApi :: !Api
  , Report -> [ApiReport]
apiReports :: ![ApiReport]
  }
  deriving stock (Report -> Report -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Report -> Report -> Bool
$c/= :: Report -> Report -> Bool
== :: Report -> Report -> Bool
$c== :: Report -> Report -> Bool
Eq, Int -> Report -> ShowS
[Report] -> ShowS
Report -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Report] -> ShowS
$cshowList :: [Report] -> ShowS
show :: Report -> String
$cshow :: Report -> String
showsPrec :: Int -> Report -> ShowS
$cshowsPrec :: Int -> Report -> ShowS
Show, forall x. Rep Report x -> Report
forall x. Report -> Rep Report x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Report x -> Report
$cfrom :: forall x. Report -> Rep Report x
Generic)
  deriving anyclass (Report -> ()
forall a. (a -> ()) -> NFData a
rnf :: Report -> ()
$crnf :: Report -> ()
NFData)

-- | Gather information about the given 'Api', including port information.
buildApiReport :: Api -> IO ApiReport
buildApiReport :: Api -> IO ApiReport
buildApiReport Api
api = do
  String
name <- Api -> IO String
apiName Api
api
  String
displayName <- Api -> IO String
apiDisplayName Api
api
  InputDevice
inDev <- Api -> String -> Int -> IO InputDevice
createInput Api
api (String
"rtmidi-report-input-" forall a. [a] -> [a] -> [a]
++ String
name) Int
0
  [(Int, String)]
inPorts <- forall d. IsDevice d => d -> IO [(Int, String)]
listPorts InputDevice
inDev
  OutputDevice
outDev <- Api -> String -> IO OutputDevice
createOutput Api
api (String
"rtmidi-report-output-" forall a. [a] -> [a] -> [a]
++ String
name)
  [(Int, String)]
outPorts <- forall d. IsDevice d => d -> IO [(Int, String)]
listPorts OutputDevice
outDev
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (Api
-> String
-> String
-> [(Int, String)]
-> [(Int, String)]
-> ApiReport
ApiReport Api
api String
name String
displayName [(Int, String)]
inPorts [(Int, String)]
outPorts)

-- | Variant of 'buildReport' that allows you to restrict it to the default APIs.
buildCustomReport
  :: Bool
  -- ^ True to report on default APIs, False to report on all compiled APIs.
  -> IO Report
buildCustomReport :: Bool -> IO Report
buildCustomReport Bool
defaultOnly = do
  InputDevice
inDev <- IO InputDevice
defaultInput
  Api
defInApi <- forall d. IsDevice d => d -> IO Api
currentApi InputDevice
inDev
  OutputDevice
outDev <- IO OutputDevice
defaultOutput
  Api
defOutApi <- forall d. IsDevice d => d -> IO Api
currentApi OutputDevice
outDev
  [Api]
apis <- if Bool
defaultOnly then forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. Eq a => [a] -> [a]
nub [Api
defInApi, Api
defOutApi]) else IO [Api]
compiledApis
  [ApiReport]
apiReps <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Api -> IO ApiReport
buildApiReport [Api]
apis
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (Api -> Api -> [ApiReport] -> Report
Report Api
defInApi Api
defOutApi [ApiReport]
apiReps)

-- | Gather information about all compiled APIs.
buildReport :: IO Report
buildReport :: IO Report
buildReport = Bool -> IO Report
buildCustomReport Bool
False