{- |
Module:  Pollock.Documentation.Doc
Copyright: (c) Trevis Elser 2023
License:  MIT

Maintainer: trevis@flipstone.com
Stability: experimental
Portability: portable
-}
module Pollock.Documentation.Doc
  ( Doc (..)
  , docAppend
  , Example (..)
  , docHasWarning
  , docHasCodeBlock
  , docHasProperty
  , docHasExamples
  ) where

{- | A simplified model for haddock documentation. Note this diverges from haddock itself as many of
the complexities, particularly around display, are not needed for this use case.
-}
data Doc
  = DocEmpty
  | DocAppend !Doc !Doc
  | DocString !String
  | DocParagraph !Doc
  | DocWarning !Doc
  | DocCodeBlock !Doc
  | DocProperty !String
  | DocExamples ![Example]

docAppend :: Doc -> Doc -> Doc
docAppend :: Doc -> Doc -> Doc
docAppend Doc
DocEmpty Doc
d = Doc
d
docAppend Doc
d Doc
DocEmpty = Doc
d
docAppend (DocString String
s1) (DocString String
s2) = String -> Doc
DocString (String
s1 String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
s2)
docAppend (DocAppend Doc
d (DocString String
s1)) (DocString String
s2) = Doc -> Doc -> Doc
DocAppend Doc
d (String -> Doc
DocString (String
s1 String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
s2))
docAppend (DocString String
s1) (DocAppend (DocString String
s2) Doc
d) = Doc -> Doc -> Doc
DocAppend (String -> Doc
DocString (String
s1 String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
s2)) Doc
d
docAppend Doc
d1 Doc
d2 = Doc -> Doc -> Doc
DocAppend Doc
d1 Doc
d2

data Example = Example
  { Example -> String
exampleExpression :: !String
  , Example -> [String]
exampleResult :: ![String]
  }

docHasWarning :: Doc -> Bool
docHasWarning :: Doc -> Bool
docHasWarning =
  let
    go :: Doc -> Bool
go Doc
doc =
      case Doc
doc of
        DocWarning Doc
_ -> Bool
True
        Doc
DocEmpty -> Bool
False
        DocString String
_ -> Bool
False
        DocProperty String
_ -> Bool
False
        DocExamples [Example]
_ -> Bool
False
        DocParagraph Doc
d -> Doc -> Bool
go Doc
d
        DocCodeBlock Doc
d -> Doc -> Bool
go Doc
d
        DocAppend Doc
d1 Doc
d2 ->
          Doc -> Bool
go Doc
d1 Bool -> Bool -> Bool
|| Doc -> Bool
go Doc
d2
   in
    Doc -> Bool
go

docHasCodeBlock :: Doc -> Bool
docHasCodeBlock :: Doc -> Bool
docHasCodeBlock =
  let
    go :: Doc -> Bool
go Doc
doc =
      case Doc
doc of
        DocCodeBlock Doc
_ -> Bool
True
        Doc
DocEmpty -> Bool
False
        DocString String
_ -> Bool
False
        DocProperty String
_ -> Bool
False
        DocExamples [Example]
_ -> Bool
False
        DocWarning Doc
d -> Doc -> Bool
go Doc
d
        DocParagraph Doc
d -> Doc -> Bool
go Doc
d
        DocAppend Doc
d1 Doc
d2 ->
          Doc -> Bool
go Doc
d1 Bool -> Bool -> Bool
|| Doc -> Bool
go Doc
d2
   in
    Doc -> Bool
go

docHasProperty :: Doc -> Bool
docHasProperty :: Doc -> Bool
docHasProperty =
  let
    go :: Doc -> Bool
go Doc
doc =
      case Doc
doc of
        DocProperty String
_ -> Bool
True
        Doc
DocEmpty -> Bool
False
        DocString String
_ -> Bool
False
        DocExamples [Example]
_ -> Bool
False
        DocCodeBlock Doc
d -> Doc -> Bool
go Doc
d
        DocWarning Doc
d -> Doc -> Bool
go Doc
d
        DocParagraph Doc
d -> Doc -> Bool
go Doc
d
        DocAppend Doc
d1 Doc
d2 ->
          Doc -> Bool
go Doc
d1 Bool -> Bool -> Bool
|| Doc -> Bool
go Doc
d2
   in
    Doc -> Bool
go

docHasExamples :: Doc -> Bool
docHasExamples :: Doc -> Bool
docHasExamples =
  let
    go :: Doc -> Bool
go Doc
doc =
      case Doc
doc of
        DocExamples [Example]
_ -> Bool
True
        Doc
DocEmpty -> Bool
False
        DocString String
_ -> Bool
False
        DocProperty String
_ -> Bool
False
        DocCodeBlock Doc
d -> Doc -> Bool
go Doc
d
        DocWarning Doc
d -> Doc -> Bool
go Doc
d
        DocParagraph Doc
d -> Doc -> Bool
go Doc
d
        DocAppend Doc
d1 Doc
d2 ->
          Doc -> Bool
go Doc
d1 Bool -> Bool -> Bool
|| Doc -> Bool
go Doc
d2
   in
    Doc -> Bool
go