module Web.Harp.Write
  ( writeConfigs
  ) where

#include "harp.h"

import Control.Applicative

import Data.Foldable (foldrM)

import Foreign.C.String
import Foreign.Marshal.Alloc
import Foreign.Marshal.Utils
import Foreign.Ptr
import Foreign.Storable

import Web.Harp.Error
import Web.Harp.Foreign
import Web.Harp.Types

-- | Write a list of configurations to a file.
writeConfigs :: [Config] -- ^ List of configurations to write to the file
             -> FilePath -- ^ Path to the file to write
             -> IO (Maybe HarpError)
writeConfigs configs path = withCString path $ \pathC -> do
  configsC <- makeList configs makeConfig
  rcC <- writeConfigsC configsC pathC
  freeListC configsC freeConfigPtr
  if rcC == 0
    then return Nothing
    else Just <$> getError

makeConfig :: Config -> IO (Ptr Config)
makeConfig config = do
  configC <- makeEmptyConfigC

  filtersC      <- makeList (configFilters      config) makeFilter
  tagsC         <- makeList (configTags         config) newCString
  resolversC    <- makeList (configResolvers    config) makeResolver
  choiceGroupsC <- makeList (configChoiceGroups config) makeChoiceGroup
  subconfigsC   <- makeList (configSubconfigs   config) makeConfig

  #{poke harp_config_t, filters}       configC filtersC
  #{poke harp_config_t, tags}          configC tagsC
  #{poke harp_config_t, resolvers}     configC resolversC
  #{poke harp_config_t, choice_groups} configC choiceGroupsC
  #{poke harp_config_t, subconfigs}    configC subconfigsC

  return configC

makeFilter :: Filter -> IO (Ptr Filter)
makeFilter filter = case filter of
  FilterHostnames hostnames -> do
    hostnamesC <- makeList hostnames newCString
    makeHostnamesFilterC hostnamesC
  FilterPorts ports -> do
    portsC <- makeList ports new
    makePortsFilterC portsC

makeResolver :: Resolver -> IO (Ptr Resolver)
makeResolver resolver = case resolver of
  ResolverStaticPath staticPath -> do
    staticPathC <- newCString staticPath
    makeStaticPathResolverC staticPathC
  ResolverServer hostname port -> do
    hostnameC <- newCString hostname
    let portC = fromInteger $ toInteger port
    makeServerResolverC hostnameC portC

makeChoiceGroup :: ChoiceGroup -> IO (Ptr ChoiceGroup)
makeChoiceGroup choiceGroup = makeList choiceGroup $ \(Choice prob config) -> do
  configC <- makeConfig config
  makeChoiceC (fromInteger $ toInteger prob) configC

makeList :: [a] -> (a -> IO (Ptr b)) -> IO (Ptr [b])
makeList xs f = foldrM (\x acc -> (`consC` acc) =<< f x) nullPtr xs