{-# LANGUAGE TemplateHaskell #-}

{- |
Module: TREXIO
Description: High-Level bindings to TREXIO library
Copyright: Phillip Seeber 2024
License: BSD-3-Clause
Maintainer: phillip.seeber@uni-jena.de
Stability: experimental
Portability: POSIX

This module provides the high-level bindings to the TREXIO library for wave function data.
The 'TREXIO.HighLevel' modules provides complete high-level bindings to the TREXIO and the function names are generated by stripping the @trexio_@ prefix from the C function names and converting to camel case.
E.g. the C function 'TREXIO.LowLevel.trexio_read_rdm_2e_updn_cholesky' is available as 'readRdm2eUpdnCholesky'.

The high-level bindings abstract mainly over three aspects of the C- (and also Python-API):

Memory management is done by the Haskell garbage collector and no pointers need to be moved around.
All multidimensional data is safely handled by the 'Data.Massiv.Array.Array' type or the 'TREXIO.CooArray.CooArray' type.

Error handling is done by throwing 'TREXIO.ExitCode' exceptions in 'IO', i.e. you don't need to check for error codes manually.
You may 'catch' 'ExitCode' exceptions via the usual mechanisms, however.

In the Python- and C-APIs, Mutlidimensional quantities require writing their size to another field, referenced by the TREXIO specification first.
For example, see this example for Python in TREXIO:

@
import trexio
coord = [    # xyz coordinates in atomic units
    [0. , 0., -0.24962655],
    [0. , 2.70519714, 1.85136466],
    [0. , -2.70519714, 1.85136466]
]
with trexio.File("water.trexio", 'w',
                 back_end=trexio.TREXIO_HDF5) as f:
    trexio.write_nucleus_num(f, len(coord))
    trexio.write_nucleus_coord(f, coord)
@

This high-level API abstracts over this and automatically writes the size of the array to the corresponding field.
Safety checks are employed to ensure, should the size already exist, that it is consistent with the array size and other arrays utilising the same size field.
Should this safety check be violated, an the 'AttrAlreadyExists' exception will be thrown, as the corresponding size field already exists and is inconsistent with the new size.
Thus, the Haskell equivalent to this is:

@
import TREXIO
import Data.Massiv.Array as Massiv

coord <- Massiv.fromListsM Par
    [ [0. , 0., -0.24962655]
    , [0. , 2.70519714, 1.85136466]
    , [0. , -2.70519714, 1.85136466]
    ]
withTrexio "water.trexio" FileWrite Hdf5 $ \\trexio ->
    writeNucleusCoord trexio coord
@

-}
module TREXIO (
    -- * Basic Operations
    ExitCode (..),
    ExitCodeC,
    version,
    Backend (..),
    Trexio,
    FileMode (..),
    hasBackend,
    open,
    close,
    markSafety,
    TrexioScheme (..),
    GroupName,
    Group (..),
    Typ (..),
    Length (..),
    DimLength (..),
    DataName,

    -- * High Level Interface
    scheme,
    intsPerDet,
    withTrexio,
    module TREXIO.HighLevel,
) where

import Control.Exception.Safe
import Control.Monad.IO.Class
import Data.Aeson
import Language.Haskell.TH
import Language.Haskell.TH.Syntax (lift)
import TREXIO.HighLevel
import TREXIO.Internal.Base
import TREXIO.Internal.TH (DataName, Group (..), GroupName, TrexioScheme (..), Typ (..), Length (..), DimLength (..))
import TREXIO.LowLevel.Scheme (scheme)

-- | Work safely with a TREXIO file handle. Prefer over 'open' and 'close'.
withTrexio :: (MonadMask m, MonadIO m) => FilePath -> FileMode -> Backend -> (Trexio -> m a) -> m a
withTrexio :: forall (m :: * -> *) a.
(MonadMask m, MonadIO m) =>
FilePath -> FileMode -> Backend -> (Trexio -> m a) -> m a
withTrexio FilePath
path FileMode
mode Backend
backend Trexio -> m a
f =
    m Trexio -> (Trexio -> m ()) -> (Trexio -> m a) -> m a
forall (m :: * -> *) a b c.
(HasCallStack, MonadMask m) =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket
        (IO Trexio -> m Trexio
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Trexio -> m Trexio) -> IO Trexio -> m Trexio
forall a b. (a -> b) -> a -> b
$ FilePath -> FileMode -> Backend -> IO Trexio
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
FilePath -> FileMode -> Backend -> m Trexio
open FilePath
path FileMode
mode Backend
backend)
        (\Trexio
trexio -> IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (Trexio -> IO ()) -> Trexio -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trexio -> IO ()
forall (m :: * -> *). (MonadIO m, MonadThrow m) => Trexio -> m ()
close (Trexio -> m ()) -> Trexio -> m ()
forall a b. (a -> b) -> a -> b
$ Trexio
trexio)
        Trexio -> m a
f