ConfigDoux.hs

{-# OPTIONS_GHC -Wno-orphans #-}

module CI.ConfigDoux where

import Conferer (fetch, mkConfig')
import Conferer.Config ((/.))
import Conferer.FromConfig (DefaultConfig (..))
import qualified Conferer.FromConfig as Conf
import qualified Conferer.Source.CLIArgs as Cli
import qualified Conferer.Source.Env as Env
import qualified Conferer.Source.Yaml as Yaml
import Control.Monad (unless)
import qualified Data.ByteString.Lazy.UTF8 as BL
import Data.Maybe (fromMaybe)
import Data.Ratio ((%))
import qualified Data.Text as T
import Data.Yaml (ToJSON (..), encodeFile, object, (.=))
import System.Directory.OsPath
import System.File.OsPath as F
import System.OsPath
import Zwirn.Doux.Types (defaultDouxClockConfig)
import qualified Zwirn.Doux.Types as Stream
import Zwirn.Language (StreamType (Doux))
import Zwirn.Language.Compiler (CIError (..), Environment (..), compilerInterpreterBoot, runCI)
import qualified Zwirn.Language.Compiler as Compiler
import Prelude hiding (log)

data StreamConfig = StreamConfig
  { streamConfigSamples :: Maybe FilePath,
    streamConfigInput :: Maybe String,
    streamConfigOutput :: Maybe String,
    streamConfigHost :: Maybe String,
    streamConfigBufferSize :: Int,
    streamConfigChannels :: Int,
    streamConfigBlockSize :: Int,
    streamConfigMaxVoices :: Int
  }
  deriving (Show)

data CiConfig = CiConfig
  { ciConfigBootPath :: FilePath,
    ciConfigCli :: Bool,
    ciConfigOverwriteBuiltin :: Bool,
    ciConfigDynamicTypes :: Bool,
    ciConfigPrecision :: Int
  }
  deriving (Show)

data FullConfig = FullConfig
  { fullConfigCi :: CiConfig,
    fullConfigStream :: StreamConfig
  }
  deriving (Show)

instance DefaultConfig CiConfig where
  configDef = CiConfig "" False False False 200

instance DefaultConfig StreamConfig where
  configDef = StreamConfig Nothing Nothing Nothing Nothing 256 2 32 32

instance DefaultConfig FullConfig where
  configDef = FullConfig configDef configDef

instance Conf.FromConfig StreamConfig where
  fromConfig key configSource = do
    path <- Conf.fetchFromConfig (key /. "samples") configSource
    input <- Conf.fetchFromConfig (key /. "input") configSource
    output <- Conf.fetchFromConfig (key /. "output") configSource
    host <- Conf.fetchFromConfig (key /. "host") configSource
    bs <- Conf.fetchFromConfig (key /. "buffersize") configSource
    cs <- Conf.fetchFromConfig (key /. "channels") configSource
    bl <- Conf.fetchFromConfig (key /. "blocksize") configSource
    mx <- Conf.fetchFromConfig (key /. "maxvoices") configSource
    return $ StreamConfig path input output host (fromMaybe 256 bs) (fromMaybe 2 cs) (fromMaybe 32 bl) (fromMaybe 32 mx)

instance Conf.FromConfig CiConfig where
  fromConfig key configSource = do
    path <- Conf.fetchFromConfig (key /. "bootpath") configSource
    cli <- Conf.fetchFromConfig (key /. "cli") configSource
    bp <- Conf.fetchFromConfig (key /. "overwritebuiltin") configSource
    dt <- Conf.fetchFromConfig (key /. "dynamictypes") configSource
    prec <- Conf.fetchFromConfig (key /. "precision") configSource
    return $ CiConfig (fromMaybe "" path) (fromMaybe False cli) (fromMaybe False bp) (fromMaybe False dt) (fromMaybe 200 prec)

instance Conf.FromConfig FullConfig where
  fromConfig key configSource = do
    ci <- Conf.fetchFromConfig (key /. "ci") configSource
    str <- Conf.fetchFromConfig (key /. "stream") configSource
    return $ FullConfig ci (fromMaybe configDef str)

instance ToJSON CiConfig where
  toJSON (CiConfig p cli o d prec) =
    object
      [ "bootpath" .= p,
        "cli" .= cli,
        "overwritebuiltin" .= o,
        "dynamictypes" .= d,
        "precision" .= prec
      ]

instance ToJSON StreamConfig where
  toJSON (StreamConfig sam inp out host buf chan block maxv) =
    object
      [ "samples" .= sam,
        "host" .= host,
        "input" .= inp,
        "output" .= out,
        "buffersize" .= buf,
        "channels" .= chan,
        "blocksize" .= block,
        "maxvoices" .= maxv
      ]

instance ToJSON FullConfig where
  toJSON (FullConfig ci str) =
    object
      [ "ci" .= toJSON ci,
        "stream" .= toJSON str
      ]

getConfigPath :: IO OsPath
getConfigPath = do
  appname <- encodeUtf "zwirnzi"
  configname <- encodeUtf "config-doux.yaml"
  configDirPath <- getXdgDirectory XdgConfig appname
  let path = configDirPath </> configname
  createDirectoryIfMissing True configDirPath
  return path

getConfig :: IO FullConfig
getConfig = do
  path <- getConfigPath
  exists <- doesFileExist path
  unless exists encodeDefault
  decoded <- decodeUtf path
  conf <-
    mkConfig'
      []
      [ Cli.fromConfig,
        Env.fromConfig "zwirnzi",
        Yaml.fromFilePath decoded
      ]
  fetch conf

toStream :: Rational -> StreamConfig -> Stream.StreamConfig
toStream prec (StreamConfig a b c d e f g h) = Stream.StreamConfig prec a b c d e f g h defaultDouxClockConfig

toCiConfig :: CiConfig -> Compiler.CiConfig
toCiConfig (CiConfig _ _ x y z) = Compiler.CiConfig x y (1 % fromIntegral z) Doux

configPath :: IO String
configPath = do
  path <- getConfigPath
  exists <- doesFileExist path
  decoded <- decodeUtf path
  if exists then return decoded else return "Config file not found!"

resetConfig :: IO String
resetConfig = encodeDefault >> return "Restored default config."

encodeDefault :: IO ()
encodeDefault = encodeConfig configDef

encodeConfig :: FullConfig -> IO ()
encodeConfig conf = do
  path <- getConfigPath
  strp <- decodeFS path
  encodeFile strp $ toJSON conf

getFile :: String -> IO String
getFile p = do
  path <- encodeUtf p
  f <- F.readFile path
  return $ BL.toString f

checkBoot :: (String -> IO ()) -> FilePath -> Environment -> IO (Maybe Environment)
checkBoot log "" _ = log "Starting without Bootfile." >> return Nothing
checkBoot log path env = do
  ospath <- encodeUtf path
  isfile <- doesFileExist ospath
  ps <-
    if isfile
      then return $ decodeUtf ospath
      else do
        isfolder <- doesDirectoryExist ospath
        if isfolder
          then do
            pss <- listDirectory ospath
            fs <- mapM decodeUtf pss
            return $ map (\f -> path ++ "/" ++ f) fs
          else return []
  res <- runCI env (compilerInterpreterBoot $ map T.pack ps)
  case res of
    Left (CIError err _) -> log ("Error in Bootfile: " ++ show err) >> return Nothing
    Right newEnv ->
      if ps /= []
        then log ("Successfully loaded Bootfiles from " ++ path) >> return (Just newEnv)
        else log ("No Bootfiles found at " ++ path) >> return Nothing

cliMode :: FullConfig -> Bool
cliMode = ciConfigCli . fullConfigCi