    {-# LANGUAGE TypeOperators #-}
    {-# LANGUAGE TypeFamilies #-}

    -- |
    -- Module      :  Internal.Devel
    -- Copyright   :  (c) Alberto Ruiz 2007-15
    -- License     :  BSD3
    -- Maintainer  :  Alberto Ruiz
    -- Stability   :  provisional
    --

    module Internal.Devel where

    import Control.Monad ( when )
    import Foreign.C.Types ( CInt )
    --import Foreign.Storable.Complex ()
    import Foreign.Ptr(Ptr)
    import           Control.Exception (SomeException, SomeAsyncException (..))
    import qualified Control.Exception as Exception
    import Internal.Vector(Vector,avec)
    import Foreign.Storable(Storable)

    -- | postfix function application (@flip ($)@)
    (//) :: x -> (x -> y) -> y
    infixl 0 //
    // :: forall x y. x -> (x -> y) -> y
    (//) = ((x -> y) -> x -> y) -> x -> (x -> y) -> y
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip (x -> y) -> x -> y
    forall a b. (a -> b) -> a -> b
    ($)

    -- GSL error codes are <= 1024
    -- | error codes for the auxiliary functions required by the wrappers
    errorCode :: CInt -> String
    errorCode :: CInt -> String
    errorCode CInt
    2000 = String
    "bad size"
    errorCode CInt
    2001 = String
    "bad function code"
    errorCode CInt
    2002 = String
    "memory problem"
    errorCode CInt
    2003 = String
    "bad file"
    errorCode CInt
    2004 = String
    "singular"
    errorCode CInt
    2005 = String
    "didn't converge"
    errorCode CInt
    2006 = String
    "the input matrix is not positive definite"
    errorCode CInt
    2007 = String
    "not yet supported in this OS"
    errorCode CInt
    n    = String
    "code "String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++CInt -> String
    forall a. Show a => a -> String
    show CInt
    n

    -- | clear the fpu
    foreign import ccall unsafe "asm_finit" finit :: IO ()

    -- | check the error code
    check :: String -> IO CInt -> IO ()
    check :: String -> IO CInt -> IO ()
    check String
    msg IO CInt
    f = do
    --  finit
        err <- IO CInt
    f
        when (err/=0) $ error (msg++": "++errorCode err)
        return ()

    -- | postfix error code check
    infixl 0 #|
    (#|) :: IO CInt -> String -> IO ()
    #| :: IO CInt -> String -> IO ()
    (#|) = (String -> IO CInt -> IO ()) -> IO CInt -> String -> IO ()
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip String -> IO CInt -> IO ()
    check

    -- | Error capture and conversion to Maybe
    mbCatch :: IO x -> IO (Maybe x)
    mbCatch :: forall x. IO x -> IO (Maybe x)
    mbCatch IO x
    act =
      Either SomeException x -> Maybe x
    forall a b. Either a b -> Maybe b
    hush (Either SomeException x -> Maybe x)
    -> IO (Either SomeException x) -> IO (Maybe x)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>
        (SomeException -> Maybe SomeException)
    -> IO x -> IO (Either SomeException x)
    forall e b a.
    Exception e =>
    (e -> Maybe b) -> IO a -> IO (Either b a)
    Exception.tryJust
          (\SomeException
    e -> if SomeException -> Bool
    isSyncException SomeException
    e then SomeException -> Maybe SomeException
    forall a. a -> Maybe a
    Just SomeException
    e else Maybe SomeException
    forall a. Maybe a
    Nothing)
          IO x
    act

      where
        hush :: Either a b -> Maybe b
        hush :: forall a b. Either a b -> Maybe b
    hush = (a -> Maybe b) -> (b -> Maybe b) -> Either a b -> Maybe b
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either (Maybe b -> a -> Maybe b
    forall a b. a -> b -> a
    const Maybe b
    forall a. Maybe a
    Nothing) b -> Maybe b
    forall a. a -> Maybe a
    Just

        isSyncException :: SomeException -> Bool
        isSyncException :: SomeException -> Bool
    isSyncException SomeException
    e =
          case SomeException -> Maybe SomeAsyncException
    forall e. Exception e => SomeException -> Maybe e
    Exception.fromException SomeException
    e of
            Just (SomeAsyncException e
    _) -> Bool
    False
            Maybe SomeAsyncException
    Nothing -> Bool
    True

    --------------------------------------------------------------------------------

    type CM b r = CInt -> CInt -> Ptr b -> r
    type CV b r = CInt -> Ptr b -> r
    type OM b r = CInt -> CInt -> CInt -> CInt -> Ptr b -> r

    type CIdxs r = CV CInt r
    type Ok = IO CInt

    infixr 5 :>, ::>, ..>
    type (:>)  t r = CV t r
    type (::>) t r = OM t r
    type (..>) t r = CM t r

    class TransArray c
      where
        type Trans c b
        type TransRaw c b
        apply      :: c -> (b -> IO r) -> (Trans c b) -> IO r
        applyRaw   :: c -> (b -> IO r) -> (TransRaw c b) -> IO r
        infixl 1 `apply`, `applyRaw`

    instance Storable t => TransArray (Vector t)
      where
        type Trans (Vector t) b    = CInt -> Ptr t -> b
        type TransRaw (Vector t) b = CInt -> Ptr t -> b
        apply :: forall b r. Vector t -> (b -> IO r) -> Trans (Vector t) b -> IO r
    apply = Vector t -> (b -> IO r) -> Trans (Vector t) b -> IO r
    Vector t -> (b -> IO r) -> (CInt -> Ptr t -> b) -> IO r
    forall a f r.
    Storable a =>
    Vector a -> (f -> IO r) -> (CInt -> Ptr a -> f) -> IO r
    avec
        {-# INLINE apply #-}
        applyRaw :: forall b r.
    Vector t -> (b -> IO r) -> TransRaw (Vector t) b -> IO r
    applyRaw = Vector t -> (b -> IO r) -> TransRaw (Vector t) b -> IO r
    Vector t -> (b -> IO r) -> (CInt -> Ptr t -> b) -> IO r
    forall a f r.
    Storable a =>
    Vector a -> (f -> IO r) -> (CInt -> Ptr a -> f) -> IO r
    avec
        {-# INLINE applyRaw #-}