Make backend fully functional for midi generation

2 files changed, 23 insertions, 6 deletions

diff --git a/backend/Api.hs b/backend/Api.hs
index 7e18bdc..dd49960 100644
--- a/backend/Api.hs
+++ b/backend/Api.hs
@@ -5,7 +5,7 @@
 module Api where
 
 import Data.Aeson
-import Data.ByteString (ByteString ())
+import Data.ByteString.Lazy (ByteString ())
 import Data.Monoid ((<>))
 import Data.Ratio
 import Data.Text (Text ())
@@ -37,9 +37,11 @@ instance FromJSON GraphWithParams where
 
 data Params
   = Params
-  { pMaxHops :: Int
+  { pMaxHops      :: Int
+  , pStartingNode :: Node
   } deriving (Show, Eq, Ord)
 
 instance FromJSON Params where
     parseJSON = withObject "Params" $ \v ->
         Params <$> v .: "maxhops"
+               <*> v .: "starting_node"
diff --git a/backend/Main.hs b/backend/Main.hs
index d6d4c9c..166d1e0 100644
--- a/backend/Main.hs
+++ b/backend/Main.hs
@@ -1,25 +1,40 @@
 module Main where
 
 import Api
-import Data.ByteString (ByteString ())
+
+import Codec.Midi (buildMidi)
+import Codec.ByteString.Builder
+import Control.Monad.IO.Class
+import Data.ByteString.Lazy (ByteString ())
+import Euterpea hiding (app)
 import Network.Wai
 import Network.Wai.Handler.Warp
 import Servant
 import Sound.Likely
+import System.Random
 
 api :: Proxy LikelyApi
 api = Proxy
 
+midiString :: ToMusic1 a => Music a -> ByteString
+midiString = toLazyByteString . buildMidi . toMidi . perform
+
 server :: Server LikelyApi
 server = genInterpretation
   where genInterpretation :: OutputFormat -> GraphWithParams -> Handler ByteString
         genInterpretation Midi g = do
-          let hops = pMaxHops . gpParams $ g
-          return undefined
+          randomGen <- liftIO $ getStdGen
+          let maxHops      = fromIntegral . pMaxHops . gpParams $ g
+              startingNode = pStartingNode . gpParams $ g
+              song         = interpretation randomGen (gpGraph g) startingNode
+          case song of
+            Nothing   -> throwError err500
+            Just song -> return . midiString $ takeNotes maxHops song
+        genInterpretation _  _ = throwError err500
 
 
 app :: Application
 app = serve api server
 
 main :: IO ()
-main = run 8081 app
+main = newStdGen >> run 8081 app