{-# LINE 1 "src/Graphics/Cairo/Drawing/TagsAndLinks.hsc" #-} {-# LANGUAGE BlockArguments, LambdaCase #-} {-# OPTIONS_GHC -Wall -fno-warn-tabs #-} module Graphics.Cairo.Drawing.TagsAndLinks where import Foreign.Ptr import Foreign.ForeignPtr import Foreign.C.String import Control.Monad.Primitive import Data.CairoContext import Graphics.Cairo.Exception cairoTagLinkInternal :: PrimMonad m => CairoT r (PrimState m) -> Name -> m a -> m a cairoTagLinkInternal :: forall (m :: * -> *) r a. PrimMonad m => CairoT r (PrimState m) -> Name -> m a -> m a cairoTagLinkInternal CairoT r (PrimState m) cr Name d = CairoT r (PrimState m) -> Either Name (Int, Maybe (Double, Double)) -> m a -> m a forall (m :: * -> *) r a. PrimMonad m => CairoT r (PrimState m) -> Either Name (Int, Maybe (Double, Double)) -> m a -> m a cairoTagLinkInternalDestPage CairoT r (PrimState m) cr (Either Name (Int, Maybe (Double, Double)) -> m a -> m a) -> Either Name (Int, Maybe (Double, Double)) -> m a -> m a forall a b. (a -> b) -> a -> b $ Name -> Either Name (Int, Maybe (Double, Double)) forall a b. a -> Either a b Left Name d cairoTagLinkInternalDestPage :: PrimMonad m => CairoT r (PrimState m) -> Either Name (Int, Maybe (Double, Double)) -> m a -> m a cairoTagLinkInternalDestPage :: forall (m :: * -> *) r a. PrimMonad m => CairoT r (PrimState m) -> Either Name (Int, Maybe (Double, Double)) -> m a -> m a cairoTagLinkInternalDestPage cr :: CairoT r (PrimState m) cr@(CairoT ForeignPtr (CairoT r (PrimState m)) fcr) Either Name (Int, Maybe (Double, Double)) d m a m = do IO () -> m () forall (m :: * -> *) a. PrimMonad m => IO a -> m a unsafeIOToPrim (IO () -> m ()) -> IO () -> m () forall a b. (a -> b) -> a -> b $ ForeignPtr (CairoT r (PrimState m)) -> (Ptr (CairoT r (PrimState m)) -> IO ()) -> IO () forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b withForeignPtr ForeignPtr (CairoT r (PrimState m)) fcr \Ptr (CairoT r (PrimState m)) pcr -> do tl <- Name -> IO CString newCString Name "Link" {-# LINE 25 "src/Graphics/Cairo/Drawing/TagsAndLinks.hsc" #-} internalAttributes d $ c_cairo_tag_begin pcr tl m a m m a -> m () -> m a forall a b. m a -> m b -> m a forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a <* IO () -> m () forall (m :: * -> *) a. PrimMonad m => IO a -> m a unsafeIOToPrim do ForeignPtr (CairoT r (PrimState m)) -> (Ptr (CairoT r (PrimState m)) -> IO ()) -> IO () forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b withForeignPtr ForeignPtr (CairoT r (PrimState m)) fcr \Ptr (CairoT r (PrimState m)) pcr -> Ptr (CairoT r (PrimState m)) -> CString -> IO () forall r s. Ptr (CairoT r s) -> CString -> IO () c_cairo_tag_end Ptr (CairoT r (PrimState m)) pcr (CString -> IO ()) -> IO CString -> IO () forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b =<< Name -> IO CString newCString Name "Link" {-# LINE 29 "src/Graphics/Cairo/Drawing/TagsAndLinks.hsc" #-} CairoT r (PrimState m) -> IO () forall r s. CairoT r s -> IO () raiseIfError CairoT r (PrimState m) cr internalAttributes :: Either Name (Int, Maybe (Double, Double)) -> (CString -> IO a) -> IO a internalAttributes :: forall a. Either Name (Int, Maybe (Double, Double)) -> (CString -> IO a) -> IO a internalAttributes = \case Left Name n -> Name -> (CString -> IO a) -> IO a forall a. Name -> (CString -> IO a) -> IO a withCString (Name -> (CString -> IO a) -> IO a) -> Name -> (CString -> IO a) -> IO a forall a b. (a -> b) -> a -> b $ Name "dest='" Name -> Name -> Name forall a. [a] -> [a] -> [a] ++ Name -> Name escape Name n Name -> Name -> Name forall a. [a] -> [a] -> [a] ++ Name "'" Right (Int p, Maybe (Double, Double) Nothing) -> Name -> (CString -> IO a) -> IO a forall a. Name -> (CString -> IO a) -> IO a withCString (Name -> (CString -> IO a) -> IO a) -> Name -> (CString -> IO a) -> IO a forall a b. (a -> b) -> a -> b $ Name "page=" Name -> Name -> Name forall a. [a] -> [a] -> [a] ++ Int -> Name forall a. Show a => a -> Name show Int p Right (Int p, Just (Double x, Double y)) -> Name -> (CString -> IO a) -> IO a forall a. Name -> (CString -> IO a) -> IO a withCString (Name -> (CString -> IO a) -> IO a) -> Name -> (CString -> IO a) -> IO a forall a b. (a -> b) -> a -> b $ Name "page=" Name -> Name -> Name forall a. [a] -> [a] -> [a] ++ Int -> Name forall a. Show a => a -> Name show Int p Name -> Name -> Name forall a. [a] -> [a] -> [a] ++ Name " pos=[" Name -> Name -> Name forall a. [a] -> [a] -> [a] ++ Double -> Name forall a. Show a => a -> Name show Double x Name -> Name -> Name forall a. [a] -> [a] -> [a] ++ Name " " Name -> Name -> Name forall a. [a] -> [a] -> [a] ++ Double -> Name forall a. Show a => a -> Name show Double y Name -> Name -> Name forall a. [a] -> [a] -> [a] ++ Name "]" cairoTagLinkUri :: PrimMonad m => CairoT r (PrimState m) -> Uri -> m a -> m a cairoTagLinkUri :: forall (m :: * -> *) r a. PrimMonad m => CairoT r (PrimState m) -> Name -> m a -> m a cairoTagLinkUri cr :: CairoT r (PrimState m) cr@(CairoT ForeignPtr (CairoT r (PrimState m)) fcr) Name u m a m = do IO () -> m () forall (m :: * -> *) a. PrimMonad m => IO a -> m a unsafeIOToPrim (IO () -> m ()) -> IO () -> m () forall a b. (a -> b) -> a -> b $ ForeignPtr (CairoT r (PrimState m)) -> (Ptr (CairoT r (PrimState m)) -> IO ()) -> IO () forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b withForeignPtr ForeignPtr (CairoT r (PrimState m)) fcr \Ptr (CairoT r (PrimState m)) pcr -> do tl <- Name -> IO CString newCString Name "Link" {-# LINE 41 "src/Graphics/Cairo/Drawing/TagsAndLinks.hsc" #-} c_cairo_tag_begin pcr tl =<< newCString ("uri='" ++ escape u ++ "'") m a m m a -> m () -> m a forall a b. m a -> m b -> m a forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a <* IO () -> m () forall (m :: * -> *) a. PrimMonad m => IO a -> m a unsafeIOToPrim do ForeignPtr (CairoT r (PrimState m)) -> (Ptr (CairoT r (PrimState m)) -> IO ()) -> IO () forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b withForeignPtr ForeignPtr (CairoT r (PrimState m)) fcr \Ptr (CairoT r (PrimState m)) pcr -> Ptr (CairoT r (PrimState m)) -> CString -> IO () forall r s. Ptr (CairoT r s) -> CString -> IO () c_cairo_tag_end Ptr (CairoT r (PrimState m)) pcr (CString -> IO ()) -> IO CString -> IO () forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b =<< Name -> IO CString newCString Name "Link" {-# LINE 45 "src/Graphics/Cairo/Drawing/TagsAndLinks.hsc" #-} CairoT r (PrimState m) -> IO () forall r s. CairoT r s -> IO () raiseIfError CairoT r (PrimState m) cr type Uri = String cairoTagDestination :: PrimMonad m => CairoT r (PrimState m) -> Name -> m a -> m a cairoTagDestination :: forall (m :: * -> *) r a. PrimMonad m => CairoT r (PrimState m) -> Name -> m a -> m a cairoTagDestination cr :: CairoT r (PrimState m) cr@(CairoT ForeignPtr (CairoT r (PrimState m)) fcr) Name n m a m = do IO () -> m () forall (m :: * -> *) a. PrimMonad m => IO a -> m a unsafeIOToPrim (IO () -> m ()) -> IO () -> m () forall a b. (a -> b) -> a -> b $ ForeignPtr (CairoT r (PrimState m)) -> (Ptr (CairoT r (PrimState m)) -> IO ()) -> IO () forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b withForeignPtr ForeignPtr (CairoT r (PrimState m)) fcr \Ptr (CairoT r (PrimState m)) pcr -> do td <- Name -> IO CString newCString Name "cairo.dest" {-# LINE 53 "src/Graphics/Cairo/Drawing/TagsAndLinks.hsc" #-} c_cairo_tag_begin pcr td =<< newCString ("name='" ++ escape n ++ "'") m a m m a -> m () -> m a forall a b. m a -> m b -> m a forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a <* IO () -> m () forall (m :: * -> *) a. PrimMonad m => IO a -> m a unsafeIOToPrim do ForeignPtr (CairoT r (PrimState m)) -> (Ptr (CairoT r (PrimState m)) -> IO ()) -> IO () forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b withForeignPtr ForeignPtr (CairoT r (PrimState m)) fcr \Ptr (CairoT r (PrimState m)) pcr -> Ptr (CairoT r (PrimState m)) -> CString -> IO () forall r s. Ptr (CairoT r s) -> CString -> IO () c_cairo_tag_end Ptr (CairoT r (PrimState m)) pcr (CString -> IO ()) -> IO CString -> IO () forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b =<< Name -> IO CString newCString Name "cairo.dest" {-# LINE 57 "src/Graphics/Cairo/Drawing/TagsAndLinks.hsc" #-} CairoT r (PrimState m) -> IO () forall r s. CairoT r s -> IO () raiseIfError CairoT r (PrimState m) cr type Name = String foreign import ccall "cairo_tag_begin" c_cairo_tag_begin :: Ptr (CairoT r s) -> CString -> CString -> IO () foreign import ccall "cairo_tag_end" c_cairo_tag_end :: Ptr (CairoT r s) -> CString -> IO () escape :: String -> String escape :: Name -> Name escape = \case Name "" -> Name "" Char '\'' : Name cs -> Name "\\'" Name -> Name -> Name forall a. [a] -> [a] -> [a] ++ Name -> Name escape Name cs Char '\\' : Name cs -> Name "\\\\" Name -> Name -> Name forall a. [a] -> [a] -> [a] ++ Name -> Name escape Name cs Char c : Name cs -> Char c Char -> Name -> Name forall a. a -> [a] -> [a] : Name -> Name escape Name cs