content: -- GF C Bindings
  -- Copyright (C) 2008-2010 Kevin Kofler
  --
  -- This library is free software; you can redistribute it and/or
  -- modify it under the terms of the GNU Lesser General Public
  -- License as published by the Free Software Foundation; either
  -- version 2.1 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
  -- Lesser General Public License for more details.
  --
  -- You should have received a copy of the GNU Lesser General Public
  -- License along with this library; if not, see <http://www.gnu.org/licenses/>.
  
  
  module PGFFFI where
  
  import PGF
  import Foreign.C.String
  import Foreign
  import Foreign.C.Types
  import Control.Exception
  import System.IO
  import Data.Maybe
  -- import GF.Text.Lexing
  
  
  -- Utility functions used in the implementation (not exported):
  
  -- This is a kind of a hack, the FFI spec doesn't guarantee that this will work.
  -- The alternative would be to use Ptr () instead of StablePtr a everywhere.
  nullStablePtr :: StablePtr a
  nullStablePtr = (castPtrToStablePtr nullPtr)
  
  sizeOfStablePtr :: Int
  sizeOfStablePtr = (sizeOf (nullStablePtr))
  
  storeList :: [a] -> Ptr (StablePtr a) -> IO ()
  storeList list buf = do
    case list of
      carlist:cdrlist -> do
        sptr <- (newStablePtr carlist)
        (poke buf sptr)
        (storeList cdrlist (plusPtr buf sizeOfStablePtr))
      [] -> (poke buf nullStablePtr)
  
  listToArray :: [a] -> IO (Ptr (StablePtr a))
  listToArray list = do
      buf <- (mallocBytes ((sizeOfStablePtr) * ((length list) + 1)))
      (storeList list buf)
      return buf
  
  
  -- * PGF
  foreign export ccall "gf_freePGF" freeStablePtr :: StablePtr PGF -> IO ()
  
  foreign export ccall gf_readPGF :: CString -> IO (StablePtr PGF)
  gf_readPGF path = do
    p <- (peekCString path)
    result <- (readPGF p)
    (newStablePtr result)
  
  -- * Identifiers
  foreign export ccall "gf_freeCId" freeStablePtr :: StablePtr CId -> IO ()
  
  foreign export ccall gf_mkCId :: CString -> IO (StablePtr CId)
  gf_mkCId str = do
    s <- (peekCString str)
    (newStablePtr (mkCId s))
  
  foreign export ccall gf_wildCId :: IO (StablePtr CId)
  gf_wildCId = do
    (newStablePtr (wildCId))
  
  foreign export ccall gf_showCId :: StablePtr CId -> IO CString
  gf_showCId cid = do
    c <- (deRefStablePtr cid)
    (newCString (showCId c))
  
  foreign export ccall gf_readCId :: CString -> IO (StablePtr CId)
  gf_readCId str = do
    s <- (peekCString str)
    case (readCId s) of
      Just x -> (newStablePtr x)
      Nothing -> (return (nullStablePtr))
  
  -- TODO: So we can create, print and free a CId, but can we do anything useful with it?
  --       We need some kind of C wrapper for the tree datastructures.
  
  -- * Languages
  foreign export ccall "gf_freeLanguage" freeStablePtr :: StablePtr Language -> IO ()
  
  foreign export ccall gf_showLanguage :: StablePtr Language -> IO CString
  gf_showLanguage lang = do
    l <- (deRefStablePtr lang)
    (newCString (showLanguage l))
  
  foreign export ccall gf_readLanguage :: CString -> IO (StablePtr Language)
  gf_readLanguage str = do
    s <- (peekCString str)
    case (readLanguage s) of
      Just x -> (newStablePtr x)
      Nothing -> (return (nullStablePtr))
  
  foreign export ccall gf_languages :: StablePtr PGF -> IO (Ptr (StablePtr Language))
  gf_languages pgf = do
    p <- (deRefStablePtr pgf)
    (listToArray (languages p))
  
  foreign export ccall gf_abstractName :: StablePtr PGF -> IO (StablePtr Language)
  gf_abstractName pgf = do
    p <- (deRefStablePtr pgf)
    (newStablePtr (abstractName p))
  
  foreign export ccall gf_languageCode :: StablePtr PGF -> StablePtr Language -> IO CString
  gf_languageCode pgf lang = do
    p <- (deRefStablePtr pgf)
    l <- (deRefStablePtr lang)
    case (languageCode p l) of
      Just s -> (newCString s)
      Nothing -> (return nullPtr)
  
  -- * Types
  foreign export ccall "gf_freeType" freeStablePtr :: StablePtr Type -> IO ()
  
  -- TODO: Hypo
  
  -- TODO: allow nonempty scope
  foreign export ccall gf_showType :: StablePtr Type -> IO CString
  gf_showType tp = do
    t <- (deRefStablePtr tp)
    (newCString (showType [] t))
  
  foreign export ccall gf_readType :: CString -> IO (StablePtr Type)
  gf_readType str = do
    s <- (peekCString str)
    case (readType s) of
      Just x -> (newStablePtr x)
      Nothing -> (return (nullStablePtr))
  
  -- TODO: mkType, mkHypo, mkDepHypo, mkImplHypo
  
  foreign export ccall gf_categories :: StablePtr PGF -> IO (Ptr (StablePtr CId))
  gf_categories pgf = do
    p <- (deRefStablePtr pgf)
    (listToArray (categories p))
  
  foreign export ccall gf_startCat :: StablePtr PGF -> IO (StablePtr Type)
  gf_startCat pgf = do
    p <- (deRefStablePtr pgf)
    (newStablePtr (startCat p))
  
  -- TODO: * Functions
  
  -- * Expressions & Trees
  -- ** Tree
  foreign export ccall "gf_freeTree" freeStablePtr :: StablePtr Tree -> IO ()
  
  -- ** Expr
  foreign export ccall "gf_freeExpr" freeStablePtr :: StablePtr Expr -> IO ()
  
  -- TODO: allow nonempty scope
  foreign export ccall gf_showExpr :: StablePtr Expr -> IO CString
  gf_showExpr expr = do
    e <- (deRefStablePtr expr)
    (newCString (showExpr [] e))
  
  foreign export ccall gf_readExpr :: CString -> IO (StablePtr Expr)
  gf_readExpr str = do
    s <- (peekCString str)
    case (readExpr s) of
      Just x -> (newStablePtr x)
      Nothing -> (return (nullStablePtr))
  
  -- * Operations
  -- ** Linearization
  foreign export ccall gf_linearize :: StablePtr PGF -> StablePtr Language -> StablePtr Tree -> IO CString
  gf_linearize pgf lang tree = do
    p <- (deRefStablePtr pgf)
    l <- (deRefStablePtr lang)
    t <- (deRefStablePtr tree)
    (newCString (linearize p l t))
  
  -- TODO: linearizeAllLang, linearizeAll, bracketedLinearize, tabularLinearizes
  -- TODO: groupResults
  
  foreign export ccall gf_showPrintName :: StablePtr PGF -> StablePtr Language -> StablePtr CId -> IO CString
  gf_showPrintName pgf lang cid = do
    p <- (deRefStablePtr pgf)
    l <- (deRefStablePtr lang)
    c <- (deRefStablePtr cid)
    (newCString (showPrintName p l c))
  
  -- TODO: BracketedString(..), FId, LIndex, Forest.showBracketedString
  
  -- ** Parsing
  foreign export ccall gf_parse :: StablePtr PGF -> StablePtr Language -> StablePtr Type -> CString -> IO (Ptr (StablePtr Tree))
  gf_parse pgf lang cat input = do
    p <- (deRefStablePtr pgf)
    l <- (deRefStablePtr lang)
    c <- (deRefStablePtr cat)
    i <- (peekCString input)
    (listToArray (parse p l c i))
  
  -- TODO: parseAllLang, parseAll, parse_, parseWithRecovery
  
  -- TODO: ** Evaluation
  -- TODO: ** Type Checking
  -- TODO: ** Low level parsing API
  -- TODO: ** Generation
  -- TODO: ** Morphological Analysis
  -- TODO: ** Visualizations
  
  -- TODO: * Browsing
  
  -- GF.Text.Lexing:
  
  -- foreign export ccall gf_stringOp :: CString -> CString -> IO CString
  -- gf_stringOp op str = do
  --   o <- (peekCString op)
  --   s <- (peekCString str)
  --   case (stringOp o) of
  --     Just fn -> (newCString (fn s))
  --     Nothing -> (return nullPtr)
  
  
  -- Unused (exception handling):
  --  (Control.Exception.catch (listToArray (parse p l c i)) (\(e::SomeException) -> do
  --  (hPutStr stderr ("error: " ++ show e))
  --  (return nullPtr)))
  