{-# LANGUAGE ForeignFunctionInterface #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  HFANN
-- Copyright   :  (c) Olivier Boudry 2008
-- License     :  BSD-style (see the file LICENSE)
-- 
-- Maintainer  :  olivier.boudry@gmail.com
-- Stability   :  experimental
-- Portability :  portable
--
-- The Fast Artificial Neural Network Library (FANN) is a free open source
-- neural network library written in C with support for both fully connected
-- and sparsely connected networks (<http://leenissen.dk/fann/>).
--
-- HFANN is a Haskell interface to this library.
--
-----------------------------------------------------------------------------

module HFANN.IO (
  saveFann,
  withSavedFann,
  ) where

import HFANN.Data (FannPtr)

import Control.Exception (bracket)

import Foreign.C.String (CString, withCString)

-- | Save an Artificial Neural Network (ANN) to a file
--
saveFann :: FannPtr -- ^ The ANN to be saved
         -> String  -- ^ The path of the file to be created
         -> IO ()
saveFann fann file = do
  withCString file $ f_fann_save fann

-- | Load an ANN and call the given function with the ANN as argument. Once
--   finished, destroy the ANN.
--
withSavedFann :: String            -- ^ The path to the file containing the ANN
              -> (FannPtr -> IO a) -- ^ A function to be run on the ANN
              -> IO a              -- ^ The return value from the given function
withSavedFann file f = do
  bracket
    (loadSavedFann file)
    destroyFann
    f

-- | Save an ANN to a file

foreign import ccall unsafe "doublefann.h fann_save"
  f_fann_save :: FannPtr -> CString -> IO ()

-- | Load a saved ANN from a file

loadSavedFann :: String -> IO FannPtr
loadSavedFann name = do
  withCString name f_fann_create_from_file

-- | Load a saved ANN from a file
--
foreign import ccall unsafe "doublefann.h fann_create_from_file"
  f_fann_create_from_file :: CString -> IO (FannPtr)

-- | Destroy the Neural Network, releasing memory.
--   (fann_destroy belongs to Fann.Base but is duplicated here so it does not
--   have to be exported)
--
foreign import ccall unsafe "doublefann.h fann_destroy"
  destroyFann :: FannPtr -> IO ()