module Web.Harp.Read
  ( readConfigs
  ) where

#include "harp.h"

import Control.Applicative

import Foreign.C.String
import Foreign.Ptr
import Foreign.Storable

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

-- | Read a list of configurations from a file.
readConfigs :: FilePath -- ^ Path of the file to read.
            -> IO (Either HarpError [Config])
readConfigs path = withCString path $ \pathC -> do
  configsC <- readConfigsC pathC nullPtr
  if configsC == nullPtr
    then Left <$> getError
    else do
      res <- traverseList configsC $ readConfig
      freeListC configsC freeConfigPtr
      return $ Right res

readConfig :: Ptr Config -> IO Config
readConfig configC = do
  filtersC      <- #{peek harp_config_t, filters}       configC
  tagsC         <- #{peek harp_config_t, tags}          configC
  resolversC    <- #{peek harp_config_t, resolvers}     configC
  choiceGroupsC <- #{peek harp_config_t, choice_groups} configC
  subconfigsC   <- #{peek harp_config_t, subconfigs}    configC

  filters      <- traverseList filtersC      readFilter
  tags         <- traverseList tagsC         peekCString
  resolvers    <- traverseList resolversC    readResolver
  choiceGroups <- traverseList choiceGroupsC readChoiceGroup
  subconfigs   <- traverseList subconfigsC   readConfig

  let config = Config
        { configFilters      = filters
        , configTags         = tags
        , configResolvers    = resolvers
        , configChoiceGroups = choiceGroups
        , configSubconfigs   = subconfigs
        }
  return config

readFilter :: Ptr Filter -> IO Filter
readFilter filterC = do
  typeC <- #{peek harp_filter_t, type} filterC
  case typeC :: Int of
    #{const HARP_FILTER_TYPE_HOSTNAMES} -> do
      hostnamesC <- #{peek harp_filter_t, hostnames} filterC
      hostnames  <- traverseList hostnamesC peekCString
      return $ FilterHostnames hostnames
    #{const HARP_FILTER_TYPE_PORTS} -> do
      portsC <- #{peek harp_filter_t, ports} filterC
      ports  <- traverseList portsC peek
      return $ FilterPorts ports
    _ -> fail $ "readFilter: unrecognized filter type " ++ show typeC

readResolver :: Ptr Resolver -> IO Resolver
readResolver resolverC = do
  typeC <- #{peek harp_filter_t, type} resolverC
  case typeC :: Int of
    #{const HARP_RESOLVER_TYPE_STATIC_PATH} -> do
      staticPathC <- #{peek harp_resolver_t, static_path} resolverC
      staticPath  <- peekCString staticPathC
      return $ ResolverStaticPath staticPath
    #{const HARP_RESOLVER_TYPE_SERVER} -> do
      serverC   <- #{peek harp_resolver_t, server} resolverC
      hostnameC <- #{peek harp_server_t, hostname} serverC
      port      <- #{peek harp_server_t, port}     serverC
      hostname  <- peekCString hostnameC
      return $ ResolverServer hostname port
    _ -> fail $ "readResolver: unrecognized resolver type " ++ show typeC

readChoiceGroup :: Ptr ChoiceGroup -> IO ChoiceGroup
readChoiceGroup choiceGroupC = traverseList choiceGroupC readChoice

readChoice :: Ptr Choice -> IO Choice
readChoice choiceC = do
  prob    <- #{peek harp_choice_t, prob}   choiceC
  configC <- #{peek harp_choice_t, config} choiceC
  config  <- readConfig configC
  return $ Choice prob config

traverseList :: Ptr [a] -> (Ptr a -> IO b) -> IO [b]
traverseList = traverseList' []

traverseList' :: [b] -> Ptr [a] -> (Ptr a -> IO b) -> IO [b]
traverseList' acc listC f =
  if listC == nullPtr
    then return acc
    else do
      elementC <- #{peek harp_list_t, element} listC
      nextC    <- #{peek harp_list_t, next}    listC
      res      <- f elementC
      traverseList' (acc ++ [res]) nextC f