----------------------------------------------------------------------------
-- |
-- Module      :  Data.Emacs.Module.Doc
-- Copyright   :  (c) Sergey Vinokurov 2022
-- License     :  Apache-2.0 (see LICENSE)
-- Maintainer  :  serg.foo@gmail.com
--
-- Defines type that provides function's documentation that would be visible
-- in Emacs.
----------------------------------------------------------------------------

{-# LANGUAGE MagicHash #-}

module Data.Emacs.Module.Doc
  ( Doc
  , mkLiteralDoc
  , mkTextDoc
  , useDocAsCString
  ) where

import Data.String
import Data.Text (Text)
import Data.Text qualified as T
import Data.Text.Foreign qualified as T
import Foreign.C.String
import GHC.Exts

data Doc
  = StaticDoc Addr#
  | DynamicDoc !Text

instance Show Doc where
  show :: Doc -> String
show = \case
    DynamicDoc Text
x   -> Text -> String
forall a. Show a => a -> String
show Text
x
    StaticDoc Addr#
addr -> ShowS
forall a. Show a => a -> String
show (Addr# -> String
unpackCString# Addr#
addr)

instance IsString Doc where
  {-# INLINE fromString #-}
  fromString :: String -> Doc
fromString = String -> Doc
mkStringDoc

mkStringDoc :: String -> Doc
mkStringDoc :: String -> Doc
mkStringDoc = Text -> Doc
mkTextDoc (Text -> Doc) -> (String -> Text) -> String -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

{-# INLINE [0] mkStringDoc #-}

{-# RULES
"Doc string literal" forall s .
   mkStringDoc (unpackCString# s) = mkLiteralDoc s
 #-}

-- | Indended to be used with unboxed string literals like this
--
-- @
-- mkLiteralDoc "foo"#
-- @
{-# INLINE mkLiteralDoc #-}
mkLiteralDoc :: Addr# -> Doc
mkLiteralDoc :: Addr# -> Doc
mkLiteralDoc = Addr# -> Doc
StaticDoc

-- | Turn abritrary bytestring into 'Doc'.
{-# INLINE mkTextDoc #-}
mkTextDoc :: Text -> Doc
mkTextDoc :: Text -> Doc
mkTextDoc = Text -> Doc
DynamicDoc

{-# INLINE useDocAsCString #-}
useDocAsCString :: Doc -> (CString -> IO a) -> IO a
useDocAsCString :: forall a. Doc -> (CString -> IO a) -> IO a
useDocAsCString Doc
doc CString -> IO a
f = case Doc
doc of
  StaticDoc Addr#
addr -> CString -> IO a
f (Addr# -> CString
forall a. Addr# -> Ptr a
Ptr Addr#
addr)
  DynamicDoc Text
str -> Text -> (CString -> IO a) -> IO a
forall a. Text -> (CString -> IO a) -> IO a
T.withCString Text
str CString -> IO a
f