1 files changed, 59 insertions, 0 deletions

diff --git a/Midi.hs b/Midi.hs
new file mode 100644
index 0000000..4609d04
--- /dev/null
+++ b/Midi.hs
@@ -0,0 +1,59 @@
+module Midi where
+import           BasePrelude
+import qualified Data.ByteString       as BS
+import           Data.ByteString.Char8 (pack)
+import           Prelude               hiding (id, (.))
+-- import           Sound.MIDI.ALSA
+import           System.Clock
+import           Database.SQLite.Simple
+import           Database.SQLite.Simple.FromRow ()
+
+import qualified Sound.ALSA.Sequencer.Event     as Event
+
+-- import qualified Sound.ALSA.Sequencer
+-- import qualified Sound.ALSA.Sequencer.Address
+-- import qualified Sound.ALSA.Sequencer.Port
+-- import qualified Sound.ALSA.Sequencer.Queue
+-- import qualified Sound.ALSA.Sequencer.Time as Time
+-- import qualified Sound.ALSA.Sequencer.RealTime as RealTime
+
+type RecordedEvent = (TimeSpec, Event.T)
+
+data Recording = StartRecording TimeSpec |
+                  RecordingInProgress TimeSpec TimeSpec [RecordedEvent]
+    deriving Show
+
+data CompleteRecording = CompleteRecording {
+    _recStart :: TimeSpec,
+    _recEnd   :: TimeSpec,
+    _recFirst :: TimeSpec,
+    _recLast  :: TimeSpec,
+    _recEvents :: [RecordedEvent]
+} deriving Show
+
+instance FromRow CompleteRecording where
+  fromRow = cons <$> field <*> field <*> field <*> field <*> field <*> field <*> field <*> field <*> field
+    where
+        cons a a' b b' c c' d d' z = CompleteRecording (TimeSpec a a') (TimeSpec b b') (TimeSpec c c') (TimeSpec d d') (bytesToMidi z)
+
+instance ToRow CompleteRecording where
+  toRow reco = toRow (s, ns, s', ns', s'', ns'', s''', ns''', midiToBytes midi)
+    where
+      (CompleteRecording (TimeSpec s ns) (TimeSpec s' ns') (TimeSpec s'' ns'') (TimeSpec s''' ns''') midi) = reco
+
+
+recordEvents :: Recording -> [RecordedEvent]-> Recording
+recordEvents (RecordingInProgress x y orig) new = RecordingInProgress x y $ new ++ orig
+recordEvents i@(StartRecording _) [] = i
+recordEvents (StartRecording x) new@(_:_) = RecordingInProgress x y new
+    where y = fst $ last new
+
+stopRecording :: Recording -> TimeSpec -> Maybe CompleteRecording
+stopRecording (RecordingInProgress x y ls@((z,_):_)) end = Just $ CompleteRecording x end y z ls
+stopRecording _ _ = Nothing
+
+
+midiToBytes :: [RecordedEvent] -> BS.ByteString
+midiToBytes = pack . show
+bytesToMidi :: BS.ByteString -> [RecordedEvent]
+bytesToMidi = undefined