text: import Control.Monad
  import Data.IORef
  import Data.Functor
  
  import Paths
  import System.FilePath
  
  import qualified Graphics.UI.Threepenny as UI
  import Graphics.UI.Threepenny.Core
  
  {-----------------------------------------------------------------------------
      Configuration
  ------------------------------------------------------------------------------}
  bars  = 4
  beats = 4
  defaultBpm = 120
  
  bpm2ms :: Int -> Int
  bpm2ms bpm = ceiling $ 1000*60 / fromIntegral bpm
  
  -- NOTE: Samples taken from "conductive-examples"
  
  instruments = words "kick snare hihat"
  
  loadInstrumentSample name = return $ "static/" ++ name ++ ".wav"
  
  {-----------------------------------------------------------------------------
      Main
  ------------------------------------------------------------------------------}
  main :: IO ()
  main = do
      static <- getStaticDir
      startGUI defaultConfig { jsStatic = Just static } setup
  
  setup :: Window -> UI ()
  setup w = void $ do
      return w # set title "Ha-ha-ha-ks-ks-ks-ha-ha-ha-ell-ell-ell"
  
      elBpm  <- UI.input # set value (show defaultBpm)
      elTick <- UI.span
      (kit, elInstruments) <- mkDrumKit
      let status = grid [[UI.string "BPM:" , element elBpm]
                        ,[UI.string "Beat:", element elTick]]
      getBody w #+ [UI.div #. "wrap" #+ (status : map element elInstruments)]
      
      timer <- UI.timer # set UI.interval (bpm2ms defaultBpm)
      eBeat <- accumE (0::Int) $
          (\beat -> (beat + 1) `mod` (beats * bars)) <$ UI.tick timer
      void . onEvent eBeat $ \beat -> do
          -- display beat count
          element elTick # set text (show $ beat + 1)
          -- play corresponding sounds
          sequence_ $ map (!! beat) kit
      
      -- allow user to set BPM
      on UI.keydown elBpm $ \keycode -> when (keycode == 13) $ void $ do
          bpm <- read <$> get value elBpm
          return timer # set UI.interval (bpm2ms bpm)
      
      -- start the timer
      UI.start timer
  
  
  type Kit        = [Instrument]
  type Instrument = [Beat]
  type Beat       = UI ()         -- play the corresponding sound
  
  mkDrumKit :: UI (Kit, [Element])
  mkDrumKit = unzip <$> mapM mkInstrument instruments
  
  mkInstrument :: String -> UI (Instrument, Element)
  mkInstrument name = do
      elCheckboxes <-
          sequence $ replicate bars  $
          sequence $ replicate beats $
              UI.input # set UI.type_ "checkbox"
  
      url     <- loadInstrumentSample name
      elAudio <- UI.audio # set (attr "preload") "1" # set UI.src url
  
      let play box = do
              checked <- get UI.checked box
              when checked $ do
                  runFunction $ ffi "%1.pause()" elAudio
                  runFunction $ ffi "%1.currentTime = 0" elAudio 
                  runFunction $ ffi "%1.play()" elAudio
          beats    = map play . concat $ elCheckboxes
          elGroups = [UI.span #. "bar" #+ map element bar | bar <- elCheckboxes]
      
      elInstrument <- UI.div #. "instrument"
          #+ (element elAudio : UI.string name : elGroups)
      
      return (beats, elInstrument)
  
  