module STM32.STLinkUSB.Env
where
import System.USB
import Control.Monad.Trans.Reader
import Control.Monad.IO.Class
import STM32.STLinkUSB.USBUtils
import STM32.STLinkUSB.Commands (API(..))
type STLT m a = ReaderT STLinkEnv m a
type STL a = forall m. MonadIO m => ReaderT STLinkEnv m a
runSTLink :: STLT IO a -> IO a
runSTLink = runSTLink' defaultDebugLogger . runReaderT
runSTLink_verbose :: STLT IO a -> IO a
runSTLink_verbose = runSTLink' verboseDebugLogger . runReaderT
runSTLink' :: Logger -> (STLinkEnv -> IO a) -> IO a
runSTLink' logger action = do
usb <- findDefaultEndpoints
runSTLinkWith logger usb action
runSTLinkWith ::
Logger
-> (Ctx, Device, EndpointAddress, EndpointAddress, EndpointAddress)
-> (STLinkEnv -> IO a)
-> IO a
runSTLinkWith
debugLogger
(usbCtx, device, rxEndpoint, txEndpoint, traceEndpoint)
action
= withUSB device $ \deviceHandle -> (action STLinkEnv {..})
where
dongleAPI = APIV2
data STLinkEnv = STLinkEnv {
usbCtx :: Ctx
,rxEndpoint :: EndpointAddress
,txEndpoint :: EndpointAddress
,traceEndpoint :: EndpointAddress
,deviceHandle :: DeviceHandle
,dongleAPI :: API
,debugLogger :: Logger
}
asksDongleAPI :: STL API
asksDongleAPI = asks dongleAPI
data LogLevel = Debug | Info | Warn | Error deriving (Show,Eq,Ord)
type Logger = LogLevel -> String -> IO ()
debugSTL :: LogLevel -> String -> STL ()
debugSTL ll msg = do
logger <- asks debugLogger
liftIO $ logger ll msg
defaultDebugLogger :: Logger
defaultDebugLogger logLevel msg = case logLevel of
Debug -> return ()
Info -> return ()
_ -> putStrLn (show logLevel ++ " : " ++ msg )
verboseDebugLogger :: Logger
verboseDebugLogger logLevel msg
= putStrLn (show logLevel ++ " : " ++ msg )