-- | An exactprintable structure for docstrings
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module GHC.Hs.DocString
  ( LHsDocString
  , HsDocString(..)
  , HsDocStringDecorator(..)
  , HsDocStringChunk(..)
  , LHsDocStringChunk
  , isEmptyDocString
  , unpackHDSC
  , mkHsDocStringChunk
  , mkHsDocStringChunkUtf8ByteString
  , pprHsDocString
  , pprHsDocStrings
  , mkGeneratedHsDocString
  , docStringChunks
  , renderHsDocString
  , renderHsDocStrings
  , exactPrintHsDocString
  , pprWithDocString
  ) where

import GHC.Prelude

import GHC.Utils.Binary
import GHC.Utils.Encoding
import GHC.Utils.Outputable as Outputable hiding ((<>))
import GHC.Types.SrcLoc
import Control.DeepSeq

import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import Data.Data
import Data.List.NonEmpty (NonEmpty(..))
import Data.List (intercalate)

type LHsDocString = Located HsDocString

-- | Haskell Documentation String
--
-- Rich structure to support exact printing
-- The location around each chunk doesn't include the decorators
data HsDocString
  = MultiLineDocString !HsDocStringDecorator !(NonEmpty LHsDocStringChunk)
     -- ^ The first chunk is preceded by "-- <decorator>" and each following chunk is preceded by "--"
     -- Example: -- | This is a docstring for 'foo'. It is the line with the decorator '|' and is always included
     --          -- This continues that docstring and is the second element in the NonEmpty list
     --          foo :: a -> a
  | NestedDocString !HsDocStringDecorator LHsDocStringChunk
     -- ^ The docstring is preceded by "{-<decorator>" and followed by "-}"
     -- The chunk contains balanced pairs of '{-' and '-}'
  | GeneratedDocString HsDocStringChunk
     -- ^ A docstring generated either internally or via TH
     -- Pretty printed with the '-- |' decorator
     -- This is because it may contain unbalanced pairs of '{-' and '-}' and
     -- not form a valid 'NestedDocString'
  deriving (HsDocString -> HsDocString -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HsDocString -> HsDocString -> Bool
$c/= :: HsDocString -> HsDocString -> Bool
== :: HsDocString -> HsDocString -> Bool
$c== :: HsDocString -> HsDocString -> Bool
Eq, Typeable HsDocString
HsDocString -> DataType
HsDocString -> Constr
(forall b. Data b => b -> b) -> HsDocString -> HsDocString
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> HsDocString -> u
forall u. (forall d. Data d => d -> u) -> HsDocString -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HsDocString -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HsDocString -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> HsDocString -> m HsDocString
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HsDocString -> m HsDocString
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HsDocString
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HsDocString -> c HsDocString
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HsDocString)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HsDocString)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HsDocString -> m HsDocString
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HsDocString -> m HsDocString
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HsDocString -> m HsDocString
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HsDocString -> m HsDocString
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> HsDocString -> m HsDocString
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> HsDocString -> m HsDocString
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> HsDocString -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> HsDocString -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> HsDocString -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> HsDocString -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HsDocString -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HsDocString -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HsDocString -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HsDocString -> r
gmapT :: (forall b. Data b => b -> b) -> HsDocString -> HsDocString
$cgmapT :: (forall b. Data b => b -> b) -> HsDocString -> HsDocString
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HsDocString)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HsDocString)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HsDocString)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HsDocString)
dataTypeOf :: HsDocString -> DataType
$cdataTypeOf :: HsDocString -> DataType
toConstr :: HsDocString -> Constr
$ctoConstr :: HsDocString -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HsDocString
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HsDocString
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HsDocString -> c HsDocString
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HsDocString -> c HsDocString
Data, Int -> HsDocString -> ShowS
[HsDocString] -> ShowS
HsDocString -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HsDocString] -> ShowS
$cshowList :: [HsDocString] -> ShowS
show :: HsDocString -> String
$cshow :: HsDocString -> String
showsPrec :: Int -> HsDocString -> ShowS
$cshowsPrec :: Int -> HsDocString -> ShowS
Show)

instance Outputable HsDocString where
  ppr :: HsDocString -> SDoc
ppr = forall doc. IsLine doc => String -> doc
text forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsDocString -> String
renderHsDocString

instance NFData HsDocString where
  rnf :: HsDocString -> ()
rnf (MultiLineDocString HsDocStringDecorator
a NonEmpty LHsDocStringChunk
b) = forall a. NFData a => a -> ()
rnf HsDocStringDecorator
a seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf NonEmpty LHsDocStringChunk
b
  rnf (NestedDocString HsDocStringDecorator
a LHsDocStringChunk
b) = forall a. NFData a => a -> ()
rnf HsDocStringDecorator
a seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf LHsDocStringChunk
b
  rnf (GeneratedDocString HsDocStringChunk
a) = forall a. NFData a => a -> ()
rnf HsDocStringChunk
a

-- | Annotate a pretty printed thing with its doc
-- The docstring comes after if is 'HsDocStringPrevious'
-- Otherwise it comes before.
-- Note - we convert MultiLineDocString HsDocStringPrevious to HsDocStringNext
-- because we can't control if something else will be pretty printed on the same line
pprWithDocString :: HsDocString -> SDoc -> SDoc
pprWithDocString :: HsDocString -> SDoc -> SDoc
pprWithDocString  (MultiLineDocString HsDocStringDecorator
HsDocStringPrevious NonEmpty LHsDocStringChunk
ds) SDoc
sd = HsDocString -> SDoc -> SDoc
pprWithDocString (HsDocStringDecorator -> NonEmpty LHsDocStringChunk -> HsDocString
MultiLineDocString HsDocStringDecorator
HsDocStringNext NonEmpty LHsDocStringChunk
ds) SDoc
sd
pprWithDocString doc :: HsDocString
doc@(NestedDocString HsDocStringDecorator
HsDocStringPrevious  LHsDocStringChunk
_) SDoc
sd = SDoc
sd forall doc. IsLine doc => doc -> doc -> doc
<+> HsDocString -> SDoc
pprHsDocString HsDocString
doc
pprWithDocString HsDocString
doc SDoc
sd = HsDocString -> SDoc
pprHsDocString HsDocString
doc SDoc -> SDoc -> SDoc
$+$ SDoc
sd


instance Binary HsDocString where
  put_ :: BinHandle -> HsDocString -> IO ()
put_ BinHandle
bh HsDocString
x = case HsDocString
x of
    MultiLineDocString HsDocStringDecorator
dec NonEmpty LHsDocStringChunk
xs -> do
      BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
0
      forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh HsDocStringDecorator
dec
      forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh forall a b. (a -> b) -> a -> b
$ forall a. Located a -> BinLocated a
BinLocated forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty LHsDocStringChunk
xs
    NestedDocString HsDocStringDecorator
dec LHsDocStringChunk
x -> do
      BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1
      forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh HsDocStringDecorator
dec
      forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh forall a b. (a -> b) -> a -> b
$ forall a. Located a -> BinLocated a
BinLocated LHsDocStringChunk
x
    GeneratedDocString HsDocStringChunk
x -> do
      BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
2
      forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh HsDocStringChunk
x
  get :: BinHandle -> IO HsDocString
get BinHandle
bh = do
    Word8
tag <- BinHandle -> IO Word8
getByte BinHandle
bh
    case Word8
tag of
      Word8
0 -> HsDocStringDecorator -> NonEmpty LHsDocStringChunk -> HsDocString
MultiLineDocString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. BinLocated a -> Located a
unBinLocated forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh)
      Word8
1 -> HsDocStringDecorator -> LHsDocStringChunk -> HsDocString
NestedDocString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. BinLocated a -> Located a
unBinLocated forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh)
      Word8
2 -> HsDocStringChunk -> HsDocString
GeneratedDocString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
      Word8
t -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"HsDocString: invalid tag " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Word8
t

data HsDocStringDecorator
  = HsDocStringNext -- ^ '|' is the decorator
  | HsDocStringPrevious -- ^ '^' is the decorator
  | HsDocStringNamed !String -- ^ '$<string>' is the decorator
  | HsDocStringGroup !Int -- ^ The decorator is the given number of '*'s
  deriving (HsDocStringDecorator -> HsDocStringDecorator -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HsDocStringDecorator -> HsDocStringDecorator -> Bool
$c/= :: HsDocStringDecorator -> HsDocStringDecorator -> Bool
== :: HsDocStringDecorator -> HsDocStringDecorator -> Bool
$c== :: HsDocStringDecorator -> HsDocStringDecorator -> Bool
Eq, Eq HsDocStringDecorator
HsDocStringDecorator -> HsDocStringDecorator -> Bool
HsDocStringDecorator -> HsDocStringDecorator -> Ordering
HsDocStringDecorator
-> HsDocStringDecorator -> HsDocStringDecorator
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: HsDocStringDecorator
-> HsDocStringDecorator -> HsDocStringDecorator
$cmin :: HsDocStringDecorator
-> HsDocStringDecorator -> HsDocStringDecorator
max :: HsDocStringDecorator
-> HsDocStringDecorator -> HsDocStringDecorator
$cmax :: HsDocStringDecorator
-> HsDocStringDecorator -> HsDocStringDecorator
>= :: HsDocStringDecorator -> HsDocStringDecorator -> Bool
$c>= :: HsDocStringDecorator -> HsDocStringDecorator -> Bool
> :: HsDocStringDecorator -> HsDocStringDecorator -> Bool
$c> :: HsDocStringDecorator -> HsDocStringDecorator -> Bool
<= :: HsDocStringDecorator -> HsDocStringDecorator -> Bool
$c<= :: HsDocStringDecorator -> HsDocStringDecorator -> Bool
< :: HsDocStringDecorator -> HsDocStringDecorator -> Bool
$c< :: HsDocStringDecorator -> HsDocStringDecorator -> Bool
compare :: HsDocStringDecorator -> HsDocStringDecorator -> Ordering
$ccompare :: HsDocStringDecorator -> HsDocStringDecorator -> Ordering
Ord, Int -> HsDocStringDecorator -> ShowS
[HsDocStringDecorator] -> ShowS
HsDocStringDecorator -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HsDocStringDecorator] -> ShowS
$cshowList :: [HsDocStringDecorator] -> ShowS
show :: HsDocStringDecorator -> String
$cshow :: HsDocStringDecorator -> String
showsPrec :: Int -> HsDocStringDecorator -> ShowS
$cshowsPrec :: Int -> HsDocStringDecorator -> ShowS
Show, Typeable HsDocStringDecorator
HsDocStringDecorator -> DataType
HsDocStringDecorator -> Constr
(forall b. Data b => b -> b)
-> HsDocStringDecorator -> HsDocStringDecorator
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> HsDocStringDecorator -> u
forall u.
(forall d. Data d => d -> u) -> HsDocStringDecorator -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HsDocStringDecorator -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HsDocStringDecorator -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HsDocStringDecorator -> m HsDocStringDecorator
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HsDocStringDecorator -> m HsDocStringDecorator
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HsDocStringDecorator
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> HsDocStringDecorator
-> c HsDocStringDecorator
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HsDocStringDecorator)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HsDocStringDecorator)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HsDocStringDecorator -> m HsDocStringDecorator
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HsDocStringDecorator -> m HsDocStringDecorator
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HsDocStringDecorator -> m HsDocStringDecorator
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HsDocStringDecorator -> m HsDocStringDecorator
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HsDocStringDecorator -> m HsDocStringDecorator
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HsDocStringDecorator -> m HsDocStringDecorator
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> HsDocStringDecorator -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> HsDocStringDecorator -> u
gmapQ :: forall u.
(forall d. Data d => d -> u) -> HsDocStringDecorator -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> HsDocStringDecorator -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HsDocStringDecorator -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HsDocStringDecorator -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HsDocStringDecorator -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HsDocStringDecorator -> r
gmapT :: (forall b. Data b => b -> b)
-> HsDocStringDecorator -> HsDocStringDecorator
$cgmapT :: (forall b. Data b => b -> b)
-> HsDocStringDecorator -> HsDocStringDecorator
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HsDocStringDecorator)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HsDocStringDecorator)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HsDocStringDecorator)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HsDocStringDecorator)
dataTypeOf :: HsDocStringDecorator -> DataType
$cdataTypeOf :: HsDocStringDecorator -> DataType
toConstr :: HsDocStringDecorator -> Constr
$ctoConstr :: HsDocStringDecorator -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HsDocStringDecorator
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HsDocStringDecorator
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> HsDocStringDecorator
-> c HsDocStringDecorator
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> HsDocStringDecorator
-> c HsDocStringDecorator
Data)

instance Outputable HsDocStringDecorator where
  ppr :: HsDocStringDecorator -> SDoc
ppr = forall doc. IsLine doc => String -> doc
text forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsDocStringDecorator -> String
printDecorator

instance NFData HsDocStringDecorator where
  rnf :: HsDocStringDecorator -> ()
rnf HsDocStringDecorator
HsDocStringNext = ()
  rnf HsDocStringDecorator
HsDocStringPrevious = ()
  rnf (HsDocStringNamed String
x) = forall a. NFData a => a -> ()
rnf String
x
  rnf (HsDocStringGroup Int
x) = forall a. NFData a => a -> ()
rnf Int
x

printDecorator :: HsDocStringDecorator -> String
printDecorator :: HsDocStringDecorator -> String
printDecorator HsDocStringDecorator
HsDocStringNext = String
"|"
printDecorator HsDocStringDecorator
HsDocStringPrevious = String
"^"
printDecorator (HsDocStringNamed String
n) = Char
'$'forall a. a -> [a] -> [a]
:String
n
printDecorator (HsDocStringGroup Int
n) = forall a. Int -> a -> [a]
replicate Int
n Char
'*'

instance Binary HsDocStringDecorator where
  put_ :: BinHandle -> HsDocStringDecorator -> IO ()
put_ BinHandle
bh HsDocStringDecorator
x = case HsDocStringDecorator
x of
    HsDocStringDecorator
HsDocStringNext -> BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
0
    HsDocStringDecorator
HsDocStringPrevious -> BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1
    HsDocStringNamed String
n -> BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
2 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh String
n
    HsDocStringGroup Int
n -> BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
3 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Int
n
  get :: BinHandle -> IO HsDocStringDecorator
get BinHandle
bh = do
    Word8
tag <- BinHandle -> IO Word8
getByte BinHandle
bh
    case Word8
tag of
      Word8
0 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure HsDocStringDecorator
HsDocStringNext
      Word8
1 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure HsDocStringDecorator
HsDocStringPrevious
      Word8
2 -> String -> HsDocStringDecorator
HsDocStringNamed forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
      Word8
3 -> Int -> HsDocStringDecorator
HsDocStringGroup forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
      Word8
t -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"HsDocStringDecorator: invalid tag " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Word8
t

type LHsDocStringChunk = Located HsDocStringChunk

-- | A contiguous chunk of documentation
newtype HsDocStringChunk = HsDocStringChunk ByteString
  deriving stock (HsDocStringChunk -> HsDocStringChunk -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HsDocStringChunk -> HsDocStringChunk -> Bool
$c/= :: HsDocStringChunk -> HsDocStringChunk -> Bool
== :: HsDocStringChunk -> HsDocStringChunk -> Bool
$c== :: HsDocStringChunk -> HsDocStringChunk -> Bool
Eq,Eq HsDocStringChunk
HsDocStringChunk -> HsDocStringChunk -> Bool
HsDocStringChunk -> HsDocStringChunk -> Ordering
HsDocStringChunk -> HsDocStringChunk -> HsDocStringChunk
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: HsDocStringChunk -> HsDocStringChunk -> HsDocStringChunk
$cmin :: HsDocStringChunk -> HsDocStringChunk -> HsDocStringChunk
max :: HsDocStringChunk -> HsDocStringChunk -> HsDocStringChunk
$cmax :: HsDocStringChunk -> HsDocStringChunk -> HsDocStringChunk
>= :: HsDocStringChunk -> HsDocStringChunk -> Bool
$c>= :: HsDocStringChunk -> HsDocStringChunk -> Bool
> :: HsDocStringChunk -> HsDocStringChunk -> Bool
$c> :: HsDocStringChunk -> HsDocStringChunk -> Bool
<= :: HsDocStringChunk -> HsDocStringChunk -> Bool
$c<= :: HsDocStringChunk -> HsDocStringChunk -> Bool
< :: HsDocStringChunk -> HsDocStringChunk -> Bool
$c< :: HsDocStringChunk -> HsDocStringChunk -> Bool
compare :: HsDocStringChunk -> HsDocStringChunk -> Ordering
$ccompare :: HsDocStringChunk -> HsDocStringChunk -> Ordering
Ord,Typeable HsDocStringChunk
HsDocStringChunk -> DataType
HsDocStringChunk -> Constr
(forall b. Data b => b -> b)
-> HsDocStringChunk -> HsDocStringChunk
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> HsDocStringChunk -> u
forall u. (forall d. Data d => d -> u) -> HsDocStringChunk -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HsDocStringChunk -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HsDocStringChunk -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HsDocStringChunk -> m HsDocStringChunk
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HsDocStringChunk -> m HsDocStringChunk
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HsDocStringChunk
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HsDocStringChunk -> c HsDocStringChunk
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HsDocStringChunk)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HsDocStringChunk)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HsDocStringChunk -> m HsDocStringChunk
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HsDocStringChunk -> m HsDocStringChunk
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HsDocStringChunk -> m HsDocStringChunk
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HsDocStringChunk -> m HsDocStringChunk
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HsDocStringChunk -> m HsDocStringChunk
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HsDocStringChunk -> m HsDocStringChunk
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> HsDocStringChunk -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> HsDocStringChunk -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> HsDocStringChunk -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> HsDocStringChunk -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HsDocStringChunk -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HsDocStringChunk -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HsDocStringChunk -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HsDocStringChunk -> r
gmapT :: (forall b. Data b => b -> b)
-> HsDocStringChunk -> HsDocStringChunk
$cgmapT :: (forall b. Data b => b -> b)
-> HsDocStringChunk -> HsDocStringChunk
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HsDocStringChunk)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HsDocStringChunk)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HsDocStringChunk)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HsDocStringChunk)
dataTypeOf :: HsDocStringChunk -> DataType
$cdataTypeOf :: HsDocStringChunk -> DataType
toConstr :: HsDocStringChunk -> Constr
$ctoConstr :: HsDocStringChunk -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HsDocStringChunk
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HsDocStringChunk
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HsDocStringChunk -> c HsDocStringChunk
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HsDocStringChunk -> c HsDocStringChunk
Data, Int -> HsDocStringChunk -> ShowS
[HsDocStringChunk] -> ShowS
HsDocStringChunk -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HsDocStringChunk] -> ShowS
$cshowList :: [HsDocStringChunk] -> ShowS
show :: HsDocStringChunk -> String
$cshow :: HsDocStringChunk -> String
showsPrec :: Int -> HsDocStringChunk -> ShowS
$cshowsPrec :: Int -> HsDocStringChunk -> ShowS
Show)
  deriving newtype (HsDocStringChunk -> ()
forall a. (a -> ()) -> NFData a
rnf :: HsDocStringChunk -> ()
$crnf :: HsDocStringChunk -> ()
NFData)

instance Binary HsDocStringChunk where
  put_ :: BinHandle -> HsDocStringChunk -> IO ()
put_ BinHandle
bh (HsDocStringChunk ByteString
bs) = forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh ByteString
bs
  get :: BinHandle -> IO HsDocStringChunk
get BinHandle
bh = ByteString -> HsDocStringChunk
HsDocStringChunk forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Binary a => BinHandle -> IO a
get BinHandle
bh

instance Outputable HsDocStringChunk where
  ppr :: HsDocStringChunk -> SDoc
ppr = forall doc. IsLine doc => String -> doc
text forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsDocStringChunk -> String
unpackHDSC

mkHsDocStringChunk :: String -> HsDocStringChunk
mkHsDocStringChunk :: String -> HsDocStringChunk
mkHsDocStringChunk String
s = ByteString -> HsDocStringChunk
HsDocStringChunk (String -> ByteString
utf8EncodeByteString String
s)

-- | Create a 'HsDocString' from a UTF8-encoded 'ByteString'.
mkHsDocStringChunkUtf8ByteString :: ByteString -> HsDocStringChunk
mkHsDocStringChunkUtf8ByteString :: ByteString -> HsDocStringChunk
mkHsDocStringChunkUtf8ByteString = ByteString -> HsDocStringChunk
HsDocStringChunk

unpackHDSC :: HsDocStringChunk -> String
unpackHDSC :: HsDocStringChunk -> String
unpackHDSC (HsDocStringChunk ByteString
bs) = ByteString -> String
utf8DecodeByteString ByteString
bs

nullHDSC :: HsDocStringChunk -> Bool
nullHDSC :: HsDocStringChunk -> Bool
nullHDSC (HsDocStringChunk ByteString
bs) = ByteString -> Bool
BS.null ByteString
bs

mkGeneratedHsDocString :: String -> HsDocString
mkGeneratedHsDocString :: String -> HsDocString
mkGeneratedHsDocString = HsDocStringChunk -> HsDocString
GeneratedDocString forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> HsDocStringChunk
mkHsDocStringChunk

isEmptyDocString :: HsDocString -> Bool
isEmptyDocString :: HsDocString -> Bool
isEmptyDocString (MultiLineDocString HsDocStringDecorator
_ NonEmpty LHsDocStringChunk
xs) = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (HsDocStringChunk -> Bool
nullHDSC forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l e. GenLocated l e -> e
unLoc) NonEmpty LHsDocStringChunk
xs
isEmptyDocString (NestedDocString HsDocStringDecorator
_ LHsDocStringChunk
s) = HsDocStringChunk -> Bool
nullHDSC forall a b. (a -> b) -> a -> b
$ forall l e. GenLocated l e -> e
unLoc LHsDocStringChunk
s
isEmptyDocString (GeneratedDocString HsDocStringChunk
x) = HsDocStringChunk -> Bool
nullHDSC HsDocStringChunk
x

docStringChunks :: HsDocString -> [LHsDocStringChunk]
docStringChunks :: HsDocString -> [LHsDocStringChunk]
docStringChunks (MultiLineDocString HsDocStringDecorator
_ (LHsDocStringChunk
x:|[LHsDocStringChunk]
xs)) = LHsDocStringChunk
xforall a. a -> [a] -> [a]
:[LHsDocStringChunk]
xs
docStringChunks (NestedDocString HsDocStringDecorator
_ LHsDocStringChunk
x) = [LHsDocStringChunk
x]
docStringChunks (GeneratedDocString HsDocStringChunk
x) = [forall l e. l -> e -> GenLocated l e
L (UnhelpfulSpanReason -> SrcSpan
UnhelpfulSpan UnhelpfulSpanReason
UnhelpfulGenerated) HsDocStringChunk
x]

-- | Pretty print with decorators, exactly as the user wrote it
pprHsDocString :: HsDocString -> SDoc
pprHsDocString :: HsDocString -> SDoc
pprHsDocString = forall doc. IsLine doc => String -> doc
text forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsDocString -> String
exactPrintHsDocString

pprHsDocStrings :: [HsDocString] -> SDoc
pprHsDocStrings :: [HsDocString] -> SDoc
pprHsDocStrings = forall doc. IsLine doc => String -> doc
text forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [[a]] -> [a]
intercalate String
"\n\n" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map HsDocString -> String
exactPrintHsDocString

-- | Pretty print with decorators, exactly as the user wrote it
exactPrintHsDocString :: HsDocString -> String
exactPrintHsDocString :: HsDocString -> String
exactPrintHsDocString (MultiLineDocString HsDocStringDecorator
dec (LHsDocStringChunk
x :| [LHsDocStringChunk]
xs))
  = [String] -> String
unlines' forall a b. (a -> b) -> a -> b
$ (String
"-- " forall a. [a] -> [a] -> [a]
++ HsDocStringDecorator -> String
printDecorator HsDocStringDecorator
dec forall a. [a] -> [a] -> [a]
++ HsDocStringChunk -> String
unpackHDSC (forall l e. GenLocated l e -> e
unLoc LHsDocStringChunk
x))
            forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (\LHsDocStringChunk
x -> String
"--" forall a. [a] -> [a] -> [a]
++ HsDocStringChunk -> String
unpackHDSC (forall l e. GenLocated l e -> e
unLoc LHsDocStringChunk
x)) [LHsDocStringChunk]
xs
exactPrintHsDocString (NestedDocString HsDocStringDecorator
dec (L SrcSpan
_ HsDocStringChunk
s))
  = String
"{-" forall a. [a] -> [a] -> [a]
++ HsDocStringDecorator -> String
printDecorator HsDocStringDecorator
dec forall a. [a] -> [a] -> [a]
++ HsDocStringChunk -> String
unpackHDSC HsDocStringChunk
s forall a. [a] -> [a] -> [a]
++ String
"-}"
exactPrintHsDocString (GeneratedDocString HsDocStringChunk
x) = case String -> [String]
lines (HsDocStringChunk -> String
unpackHDSC HsDocStringChunk
x) of
  [] -> String
""
  (String
x:[String]
xs) -> [String] -> String
unlines' forall a b. (a -> b) -> a -> b
$ ( String
"-- |" forall a. [a] -> [a] -> [a]
++ String
x)
                    forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (\String
y -> String
"--"forall a. [a] -> [a] -> [a]
++String
y) [String]
xs

-- | Just get the docstring, without any decorators
renderHsDocString :: HsDocString -> String
renderHsDocString :: HsDocString -> String
renderHsDocString (MultiLineDocString HsDocStringDecorator
_ (LHsDocStringChunk
x :| [LHsDocStringChunk]
xs)) = [String] -> String
unlines' forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (HsDocStringChunk -> String
unpackHDSC forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l e. GenLocated l e -> e
unLoc) (LHsDocStringChunk
xforall a. a -> [a] -> [a]
:[LHsDocStringChunk]
xs)
renderHsDocString (NestedDocString HsDocStringDecorator
_ LHsDocStringChunk
ds) = HsDocStringChunk -> String
unpackHDSC forall a b. (a -> b) -> a -> b
$ forall l e. GenLocated l e -> e
unLoc LHsDocStringChunk
ds
renderHsDocString (GeneratedDocString HsDocStringChunk
x) = HsDocStringChunk -> String
unpackHDSC HsDocStringChunk
x

-- | Don't add a newline to a single string
unlines' :: [String] -> String
unlines' :: [String] -> String
unlines' = forall a. [a] -> [[a]] -> [a]
intercalate String
"\n"

-- | Just get the docstring, without any decorators
-- Separates docstrings using "\n\n", which is how haddock likes to render them
renderHsDocStrings :: [HsDocString] -> String
renderHsDocStrings :: [HsDocString] -> String
renderHsDocStrings = forall a. [a] -> [[a]] -> [a]
intercalate String
"\n\n" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map HsDocString -> String
renderHsDocString