content: {-# LANGUAGE FlexibleContexts, ForeignFunctionInterface #-}
  
  module CodeBuild(DSO
                  , createFn
                  , dl
                  , dsoExecuteFn
                  , dsoInit2Fn
                  , dsoSetFn
                  , dsoSetCCFn
                  , dsoSetStringFn
                  , makeDSOFromSynth
                  , setStateVar
                  , setStringStateVar
                  ) where
  
  import Foreign.C.String
  import Foreign.C.Types
  import Foreign.Ptr
  import Control.Monad
  import System.Directory
  import System.IO.Temp
  import Data.Hashable
  import System.Posix.DynamicLinker
  import Control.Monad.Writer
  import System.Process
  import Control.Monad.Trans.Error
  import qualified Data.Set as S
  
  import CodeGen
  import Synth
  
  foreign import ccall "dynamic" mkCreate :: FunPtr CreateFn -> CreateFn
  foreign import ccall "dynamic" mkInit2 :: FunPtr Init2Fn -> Init2Fn
  foreign import ccall "dynamic" mkSet :: FunPtr SetFn -> SetFn
  foreign import ccall "dynamic" mkSetCC :: FunPtr SetCCFn -> SetCCFn
  foreign import ccall "dynamic" mkSetString :: FunPtr SetStringFn -> SetStringFn
  
  compileCommand :: String -> [String] -> String -> String
  compileCommand sourceName extra_libs libraryName =
      let clang_options = ["-O3",
                           "-ffast-math",
                           "-Wno-logical-op-parentheses",
                           "-dynamiclib",
                           "-std=gnu99",
                           "-lm"]
      in "clang " ++ unwords clang_options ++ " "
                  ++ unwords ("moodler_lib.o" : extra_libs) ++ " " ++ sourceName
                  ++ " -o " ++ libraryName
  
  compile :: String -> [String] -> String -> IO ()
  compile sourceName linkList libraryName = do
      let extra_libs = S.toList (S.fromList linkList)
      let command = compileCommand sourceName extra_libs libraryName
      liftIO $ putStrLn $ "Building with: " ++ show command
      compileHandle <- runCommand command
      void $ waitForProcess compileHandle
      return ()
  
  type CreateFn = IO (Ptr ())
  type Init2Fn = Ptr () -> CString -> IO ()
  type SetFn = Ptr () -> CString -> CString -> CDouble -> IO ()
  type SetCCFn = Int -> CFloat -> IO ()
  type SetStringFn = Ptr () -> CString -> CString -> CString -> IO ()
  
  -- Represents a DSO loaded into memory along with Haskell wrappers
  -- around C functions within it.
  data DSO = DSO { dl :: DL
                 , createFn :: CreateFn
                 , dsoInit2Fn :: Init2Fn
                 , dsoExecuteFn :: FunPtr ()
                 , dsoSetCCFn :: SetCCFn
                 , dsoSetFn :: SetFn
                 , dsoSetStringFn :: SetStringFn }
  
  makeDso :: String -> [String] -> IO DSO
  makeDso code linkList =
      --let tmpDir = "gensrc" ++ show (hash code)
      --createDirectoryIfMissing False tmpDir
      withSystemTempDirectory
          ("gensrc" ++ show (hash code) ++ ".") $ \tmpDir -> do
          --putStrLn code
          let tmpSrcFile = tmpDir ++ "/gen.c"
          let tmpSoFile = tmpDir ++ "/gen.so"
          writeFile tmpSrcFile code
          compile tmpSrcFile linkList tmpSoFile
          so <- dlopen tmpSoFile [RTLD_NOW, RTLD_LOCAL]
  
          create <- dlsym so "create"
          ini2 <- dlsym so "init2"
          execute <- dlsym so "execute"
          setCC <- dlsym so "set_cc"
          set <- dlsym so "set"
          setString <- dlsym so "set_string"
  
          return $ DSO so (mkCreate create) (mkInit2 ini2) execute
                                            (mkSetCC setCC)
                                            (mkSet set)
                                            (mkSetString setString)
      -- End of tmp dir bit
  
  -- Set value in currently running audo generator
  setStateVar :: SetFn -> Ptr () -> String -> String -> Float -> IO ()
  setStateVar set dataPtr nodeName stateVar value =
      withCString nodeName $ \nodeString ->
          withCString stateVar $ \stateString ->
              set dataPtr nodeString stateString (realToFrac value)
  
  setStringStateVar :: SetStringFn -> Ptr () -> String -> String -> String -> IO ()
  setStringStateVar set dataPtr nodeName stateVar value =
      withCString nodeName $ \nodeString ->
          withCString stateVar $ \stateString ->
              withCString value $ \valueString ->
                  set dataPtr nodeString stateString valueString
  
  makeDSOFromSynth :: Synth -> Module -> ErrorT String IO DSO
  makeDSOFromSynth synth out = do
      currentDirectory <- liftIO getCurrentDirectory
      let (linkList, code) = runWriter (gen currentDirectory synth out)
      --liftIO $ putStrLn code
      liftIO $ makeDso code linkList
  