-- GENERATED by C->Haskell Compiler, version 0.28.8 Switcheroo, 25 November 2017 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "src/Hikchr.chs" #-}
{-# LANGUAGE ForeignFunctionInterface #-}

module Hikchr (
  hikchr,
  hikchrCustom,
  HikchrConfig (..),
  defaultConfig,
) where
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.Ptr as C2HSImp



import Data.Text (Text)
import Data.Text.Encoding (decodeUtf8, encodeUtf8)

import Data.ByteString.Char8 qualified as BS
import Foreign.C.String (CString)
import Foreign.C.Types (CInt)
import Foreign.Marshal.Alloc (allocaBytes)
import Foreign.Ptr (Ptr, nullPtr)
import Foreign.Storable (peek, sizeOf)




pikchr :: (CString) -- ^ Input PIKCHR source text
 -> (CString) -- ^ Add class="%s" to <svg> markup
 -> (CInt) -- ^ Flags used to influence rendering behavior
 -> (Ptr CInt) -- ^ `width` of <svg> or `NULL`
 -> (Ptr CInt) -- ^ `height` or `NULL`
 -> IO ((CString)) -- ^ SVG markup

pikchr :: CString -> CString -> CInt -> Ptr CInt -> Ptr CInt -> IO CString
pikchr CString
a1 CString
a2 CInt
a3 Ptr CInt
a4 Ptr CInt
a5 =
  (((CString -> IO CString) -> CString -> IO CString)
-> CString -> (CString -> IO CString) -> IO CString
forall a b c. (a -> b -> c) -> b -> a -> c
flip (CString -> IO CString) -> CString -> IO CString
forall a b. (a -> b) -> a -> b
($)) CString
a1 ((CString -> IO CString) -> IO CString)
-> (CString -> IO CString) -> IO CString
forall a b. (a -> b) -> a -> b
$ \CString
a1' -> 
  (((CString -> IO CString) -> CString -> IO CString)
-> CString -> (CString -> IO CString) -> IO CString
forall a b c. (a -> b -> c) -> b -> a -> c
flip (CString -> IO CString) -> CString -> IO CString
forall a b. (a -> b) -> a -> b
($)) CString
a2 ((CString -> IO CString) -> IO CString)
-> (CString -> IO CString) -> IO CString
forall a b. (a -> b) -> a -> b
$ \CString
a2' -> 
  let {a3' :: CUInt
a3' = CInt -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
a3} in 
  let {a4' :: Ptr CInt
a4' = Ptr CInt -> Ptr CInt
forall a. a -> a
id Ptr CInt
a4} in 
  let {a5' :: Ptr CInt
a5' = Ptr CInt -> Ptr CInt
forall a. a -> a
id Ptr CInt
a5} in 
  CString -> CString -> CUInt -> Ptr CInt -> Ptr CInt -> IO CString
pikchr'_ CString
a1' CString
a2' CUInt
a3' Ptr CInt
a4' Ptr CInt
a5' IO CString -> (CString -> IO CString) -> IO CString
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CString
res ->
  CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
res IO CString -> (CString -> IO CString) -> IO CString
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CString
res' ->
  CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (CString
res')

{-# LINE 30 "src/Hikchr.chs" #-}


data HikchrConfig = HikchrConfig
  { svgClass :: Maybe Text
  , darkMode :: Bool
  , width :: Maybe Int
  , height :: Maybe Int
  }


defaultConfig :: HikchrConfig
defaultConfig =
  HikchrConfig
    { svgClass = Nothing
    , darkMode = False
    , width = Nothing
    , height = Nothing
    }


hikchr :: Text -> IO (Either Text Text)
hikchr :: Text -> IO (Either Text Text)
hikchr =
  HikchrConfig -> Text -> IO (Either Text Text)
hikchrCustom HikchrConfig
defaultConfig


withClassMaybe :: Maybe Text -> (CString -> IO a) -> IO a
withClassMaybe :: forall a. Maybe Text -> (CString -> IO a) -> IO a
withClassMaybe Maybe Text
Nothing CString -> IO a
f = CString -> IO a
f CString
forall a. Ptr a
nullPtr
withClassMaybe (Just Text
cls) CString -> IO a
f = ByteString -> (CString -> IO a) -> IO a
forall a. ByteString -> (CString -> IO a) -> IO a
BS.useAsCString (Text -> ByteString
encodeUtf8 Text
cls) CString -> IO a
f


hikchrCustom :: HikchrConfig -> Text -> IO (Either Text Text)
hikchrCustom :: HikchrConfig -> Text -> IO (Either Text Text)
hikchrCustom HikchrConfig
config Text
pikchrScript = do
  ByteString
-> (CString -> IO (Either Text Text)) -> IO (Either Text Text)
forall a. ByteString -> (CString -> IO a) -> IO a
BS.useAsCString (Text -> ByteString
encodeUtf8 Text
pikchrScript) ((CString -> IO (Either Text Text)) -> IO (Either Text Text))
-> (CString -> IO (Either Text Text)) -> IO (Either Text Text)
forall a b. (a -> b) -> a -> b
$ \CString
scriptStr ->
    Maybe Text
-> (CString -> IO (Either Text Text)) -> IO (Either Text Text)
forall a. Maybe Text -> (CString -> IO a) -> IO a
withClassMaybe HikchrConfig
config.svgClass ((CString -> IO (Either Text Text)) -> IO (Either Text Text))
-> (CString -> IO (Either Text Text)) -> IO (Either Text Text)
forall a b. (a -> b) -> a -> b
$ \CString
classStrPtr ->
      Int -> (Ptr CInt -> IO (Either Text Text)) -> IO (Either Text Text)
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes (CInt -> Int
forall a. Storable a => a -> Int
sizeOf (CInt
forall a. HasCallStack => a
undefined :: CInt)) ((Ptr CInt -> IO (Either Text Text)) -> IO (Either Text Text))
-> (Ptr CInt -> IO (Either Text Text)) -> IO (Either Text Text)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
widthPtr ->
        Int -> (Ptr CInt -> IO (Either Text Text)) -> IO (Either Text Text)
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes (CInt -> Int
forall a. Storable a => a -> Int
sizeOf (CInt
forall a. HasCallStack => a
undefined :: CInt)) ((Ptr CInt -> IO (Either Text Text)) -> IO (Either Text Text))
-> (Ptr CInt -> IO (Either Text Text)) -> IO (Either Text Text)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
heightPtr -> do
          let
            -- PIKCHR_PLAINTEXT_ERRORS is always set
            flags :: CInt
flags = if HikchrConfig
config.darkMode then CInt
3 else CInt
1

          CString
result <- CString -> CString -> CInt -> Ptr CInt -> Ptr CInt -> IO CString
pikchr CString
scriptStr CString
classStrPtr CInt
flags Ptr CInt
widthPtr Ptr CInt
heightPtr
          CInt
resCode <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
widthPtr
          ByteString
resultBS <- CString -> IO ByteString
BS.packCString CString
result

          Either Text Text -> IO (Either Text Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text Text -> IO (Either Text Text))
-> Either Text Text -> IO (Either Text Text)
forall a b. (a -> b) -> a -> b
$
            if CInt
resCode CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
< CInt
0
              then Text -> Either Text Text
forall a b. a -> Either a b
Left (Text -> Either Text Text) -> Text -> Either Text Text
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
decodeUtf8 ByteString
resultBS
              else Text -> Either Text Text
forall a b. b -> Either a b
Right (Text -> Either Text Text) -> Text -> Either Text Text
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
decodeUtf8 ByteString
resultBS

foreign import ccall safe "Hikchr.chs.h pikchr"
  pikchr'_ :: ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CUInt -> ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO (C2HSImp.Ptr C2HSImp.CChar)))))))