module Sound.Tidal.Config where

import Data.Int(Int64)
import Foreign.C.Types (CDouble)

{-
    Config.hs - For default Tidal configuration values.
    Copyright (C) 2020, Alex McLean and contributors

    This library is free software: you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation, either version 3 of the License, or
    (at your option) any later version.

    This library is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this library.  If not, see <http://www.gnu.org/licenses/>.
-}

data Config = Config {Config -> Bool
cCtrlListen :: Bool,
                      Config -> String
cCtrlAddr :: String,
                      Config -> Int
cCtrlPort :: Int,
                      Config -> Bool
cCtrlBroadcast :: Bool,
                      Config -> Double
cFrameTimespan :: Double,
                      Config -> Bool
cEnableLink :: Bool,
                      Config -> Double
cProcessAhead :: Double,
                      Config -> String
cTempoAddr :: String,
                      Config -> Int
cTempoPort :: Int,
                      Config -> Int
cTempoClientPort :: Int,
                      Config -> Int64
cSkipTicks :: Int64,
                      Config -> Bool
cVerbose :: Bool,
                      Config -> CDouble
cQuantum :: CDouble,
                      Config -> CDouble
cBeatsPerCycle :: CDouble
                     }

defaultConfig :: Config
defaultConfig :: Config
defaultConfig = Config {cCtrlListen :: Bool
cCtrlListen = Bool
True,
                        cCtrlAddr :: String
cCtrlAddr =String
"127.0.0.1",
                        cCtrlPort :: Int
cCtrlPort = Int
6010,
                        cCtrlBroadcast :: Bool
cCtrlBroadcast = Bool
False,
                        cFrameTimespan :: Double
cFrameTimespan = Double
1forall a. Fractional a => a -> a -> a
/Double
20,
                        cEnableLink :: Bool
cEnableLink = Bool
True,
                        cProcessAhead :: Double
cProcessAhead = Double
3forall a. Fractional a => a -> a -> a
/Double
10,
                        cTempoAddr :: String
cTempoAddr = String
"127.0.0.1",
                        cTempoPort :: Int
cTempoPort = Int
9160,
                        cTempoClientPort :: Int
cTempoClientPort = Int
0, -- choose at random
                        cSkipTicks :: Int64
cSkipTicks = Int64
10,
                        cVerbose :: Bool
cVerbose = Bool
True,
                        cQuantum :: CDouble
cQuantum = CDouble
4,
                        cBeatsPerCycle :: CDouble
cBeatsPerCycle = CDouble
4
                       }