content: {-# LANGUAGE OverloadedStrings, CPP #-}
  -- | High-ish level bindings to the HTML5 audio tag and JS API.
  module Haste.Audio (
      module Events,
      Audio, AudioSettings (..), AudioType (..), AudioSource (..),
      AudioPreload (..), AudioState (..), Seek (..),
      defaultAudioSettings,
      mkSource, newAudio, setSource,
      getState,
      setMute, isMute, toggleMute,
      setLooping, isLooping, toggleLooping,
      getVolume, setVolume, modVolume,
      play, pause, stop, togglePlaying,
      seek, getDuration, getCurrentTime
    ) where
  import Haste.Audio.Events as Events
  import Haste.DOM.JSString
  import Haste.Events.Core
  import Haste.Prim.Foreign
  import Haste.Prim.JSType
  import Haste.Prim
  import Control.Monad
  import Control.Monad.IO.Class
  import Data.String
  
  -- | Represents an audio player.
  data Audio = Audio Elem
  
  instance IsElem Audio where
    elemOf (Audio e) = e
    fromElem e = do
      tn <- getProp e "tagName"
      return $ case tn of
        "AUDIO" -> Just $ Audio e
        _       -> Nothing
  
  instance EventSource Audio where
    eventSource = eventSource . elemOf
  
  data AudioState = Playing | Paused | Ended
    deriving (Show, Eq)
  data AudioType = MP3 | OGG | WAV
    deriving (Show, Eq)
  data AudioSource = AudioSource !AudioType !JSString
    deriving (Show, Eq)
  data AudioPreload = None | Metadata | Auto
    deriving Eq
  data Seek = Start | End | Seconds Double
    deriving Eq
  
  instance JSType AudioPreload where
    toJSString None     = "none"
    toJSString Metadata = "metadata"
    toJSString Auto     = "auto"
    fromJSString "none"     = Just None
    fromJSString "metadata" = Just Metadata
    fromJSString "auto"     = Just Auto
    fromJSString _          = Nothing
  
  data AudioSettings = AudioSettings {
      -- | Show controls?
      --   Default: False
      audioControls :: !Bool,
      -- | Immediately start playing?
      --   Default: False
      audioAutoplay :: !Bool,
      -- | Initially looping?
      --   Default: False
      audioLooping  :: !Bool,
      -- | How much audio to preload.
      --   Default: Auto
      audioPreload  :: !AudioPreload,
      -- | Initially muted?
      --   Default: False
      audioMuted    :: !Bool,
      -- | Initial volume
      --   Default: 0
      audioVolume   :: !Double
    }
  
  defaultAudioSettings :: AudioSettings
  defaultAudioSettings = AudioSettings {
      audioControls = False,
      audioAutoplay = False,
      audioLooping = False,
      audioPreload = Auto,
      audioMuted = False,
      audioVolume = 0
    }
  
  -- | Create an audio source with automatically detected media type, based on
  --   the given URL's file extension.
  --   Returns Nothing if the given URL has an unrecognized media type.
  mkSource :: JSString -> Maybe AudioSource
  mkSource url =
    case take 3 $ reverse $ fromJSStr url of
      "3pm" -> Just $ AudioSource MP3 url
      "ggo" -> Just $ AudioSource OGG url
      "vaw" -> Just $ AudioSource WAV url
      _     -> Nothing
  
  instance IsString AudioSource where
    fromString s =
      case mkSource $ Data.String.fromString s of
        Just src -> src
        _        -> error $ "Not a valid audio source: " ++ s
  
  mimeStr :: AudioType -> JSString
  mimeStr MP3 = "audio/mpeg"
  mimeStr OGG = "audio/ogg"
  mimeStr WAV = "audio/wav"
  
  -- | Create a new audio element.
  newAudio :: MonadIO m => AudioSettings -> [AudioSource] -> m Audio
  newAudio cfg sources = liftIO $ do
    srcs <- forM sources $ \(AudioSource t url) -> do
      newElem "source" `with` ["type" =: mimeStr t, "src" =: toJSString url]
    Audio <$> newElem "audio" `with` [
        "controls" =: falseAsEmpty (audioControls cfg),
        "autoplay" =: falseAsEmpty (audioAutoplay cfg),
        "loop"     =: falseAsEmpty (audioLooping cfg),
        "muted"    =: falseAsEmpty (audioMuted cfg),
        "volume"   =: toJSString (audioVolume cfg),
        "preload"  =: toJSString (audioPreload cfg),
        children srcs
      ]
  
  -- | Returns "true" or "", depending on the given boolean.
  falseAsEmpty :: Bool -> JSString
  falseAsEmpty True = "true"
  falseAsEmpty _    = ""
  
  -- | (Un)mute the given audio object.
  setMute :: MonadIO m => Audio -> Bool -> m ()
  setMute (Audio e) = setAttr e "muted" . falseAsEmpty
  
  -- | Is the given audio object muted?
  isMute :: MonadIO m => Audio -> m Bool
  isMute (Audio e) = liftIO $ maybe False id . fromJSString <$> getProp e "muted"
  
  -- | Mute/unmute.
  toggleMute :: MonadIO m => Audio -> m ()
  toggleMute a = isMute a >>= setMute a . not
  
  -- | Set whether the given sound should loop upon completion or not.
  setLooping :: MonadIO m => Audio -> Bool -> m ()
  setLooping (Audio e) = setAttr e "loop" . falseAsEmpty
  
  -- | Is the given audio object looping?
  isLooping :: MonadIO m => Audio -> m Bool
  isLooping (Audio e) =
    liftIO $ maybe False id . fromJSString <$> getProp e "looping"
  
  -- | Toggle looping on/off.
  toggleLooping :: MonadIO m => Audio -> m ()
  toggleLooping a = isLooping a >>= setLooping a . not
  
  -- | Starts playing audio from the given element.
  play :: MonadIO m => Audio -> m ()
  play a@(Audio e) = do
      st <- getState a
      when (st == Ended) $ seek a Start
      liftIO $ play' e
    where
      play' :: Elem -> IO ()
      play' = ffi "(function(x){x.play();})"
  
  -- | Get the current state of the given audio object.
  getState :: MonadIO m => Audio -> m AudioState
  getState (Audio e) = liftIO $ do
    ended <- maybe False id . fromJSString <$> getProp e "ended"
    if ended
      then return Ended
      else maybe Playing paused . fromJSString <$> getProp e "paused"
    where
      paused True = Paused
      paused _    = Playing
  
  -- | Pause the given audio element.
  pause :: MonadIO m => Audio -> m ()
  pause (Audio e) = liftIO $ pause' e
  
  pause' :: Elem -> IO ()
  pause' = ffi "(function(x){x.pause();})"
  
  -- | If playing, stop. Otherwise, start playing.
  togglePlaying :: MonadIO m => Audio -> m ()
  togglePlaying a = do
    st <- getState a
    case st of
      Playing    -> pause a
      Ended      -> seek a Start >> play a
      Paused     -> play a
  
  -- | Stop playing a track, and seek back to its beginning.
  stop :: MonadIO m => Audio -> m ()
  stop a = pause a >> seek a Start
  
  -- | Get the volume for the given audio element as a value between 0 and 1.
  getVolume :: MonadIO m => Audio -> m Double
  getVolume (Audio e) = liftIO $ maybe 0 id . fromJSString <$> getProp e "volume"
  
  -- | Set the volume for the given audio element. The value will be clamped to
  --   [0, 1].
  setVolume :: MonadIO m => Audio -> Double -> m ()
  setVolume (Audio e) = setProp e "volume" . toJSString . clamp
  
  -- | Modify the volume for the given audio element. The resulting volume will
  --   be clamped to [0, 1].
  modVolume :: MonadIO m => Audio -> Double -> m ()
  modVolume a diff = getVolume a >>= setVolume a . (+ diff)
  
  -- | Clamp a value to [0, 1].
  clamp :: Double -> Double
  clamp = max 0 . min 1
  
  -- | Seek to the specified time.
  seek :: MonadIO m => Audio -> Seek -> m ()
  seek a@(Audio e) st = liftIO $ do
      case st of
        Start     -> seek' e 0
        End       -> getDuration a >>= seek' e
        Seconds s -> seek' e s
    where
      seek' :: Elem -> Double -> IO ()
      seek' = ffi "(function(e,t) {e.currentTime = t;})"
  
  -- | Get the duration of the loaded sound, in seconds.
  getDuration :: MonadIO m => Audio -> m Double
  getDuration (Audio e) = do
    dur <- getProp e "duration"
    case fromJSString dur of
      Just d -> return d
      _      -> return 0
  
  -- | Get the current play time of the loaded sound, in seconds.
  getCurrentTime :: MonadIO m => Audio -> m Double
  getCurrentTime (Audio e) = do
    dur <- getProp e "currentTime"
    case fromJSString dur of
      Just d -> return d
      _      -> return 0
  
  -- | Set the source of the given audio element.
  setSource :: MonadIO m => Audio -> AudioSource -> m ()
  setSource (Audio e) (AudioSource _ url) = setProp e "src" (toJSString url)
  