-- | Data types and functions for representing a simplified form of PureScript
-- code, intended for use in e.g. HTML documentation.

module Language.PureScript.Docs.RenderedCode.Types
 ( RenderedCodeElement(..)
 , ContainingModule(..)
 , asContainingModule
 , maybeToContainingModule
 , fromQualified
 , Namespace(..)
 , Link(..)
 , FixityAlias
 , RenderedCode
 , outputWith
 , sp
 , syntax
 , keyword
 , keywordForall
 , keywordData
 , keywordType
 , keywordClass
 , keywordWhere
 , keywordFixity
 , keywordAs
 , ident
 , dataCtor
 , typeCtor
 , typeOp
 , typeVar
 , roleAnn
 , alias
 , aliasName
 ) where

import Prelude
import GHC.Generics (Generic)

import Control.DeepSeq (NFData)
import Control.Monad.Error.Class (MonadError(..))

import Data.Aeson.BetterErrors (Parse, nth, withText, withValue, toAesonParser, perhaps, asText)
import Data.Aeson qualified as A
import Data.Text (Text)
import Data.Text qualified as T
import Data.ByteString.Lazy qualified as BS
import Data.Text.Encoding qualified as TE

import Language.PureScript.Names (pattern ByNullSourcePos, Ident(..), ModuleName, OpName(..), OpNameType(..), ProperName(..), ProperNameType(..), Qualified(..), QualifiedBy(..), moduleNameFromString, runIdent, runModuleName)
import Language.PureScript.AST (Associativity(..))

-- | Given a list of actions, attempt them all, returning the first success.
-- If all the actions fail, 'tryAll' returns the first argument.
tryAll :: MonadError e m => m a -> [m a] -> m a
tryAll :: forall e (m :: * -> *) a. MonadError e m => m a -> [m a] -> m a
tryAll = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall a b. (a -> b) -> a -> b
$ \m a
x m a
y -> forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError m a
x (forall a b. a -> b -> a
const m a
y)

firstEq :: Text -> Parse Text a -> Parse Text a
firstEq :: forall a. Text -> Parse Text a -> Parse Text a
firstEq Text
str Parse Text a
p = forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Int -> ParseT err m a -> ParseT err m a
nth Int
0 (forall (m :: * -> *) err a.
(Functor m, Monad m) =>
(Text -> Either err a) -> ParseT err m a
withText (forall {a} {a}. (Eq a, IsString a) => a -> a -> Either a ()
eq Text
str)) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parse Text a
p
  where
  eq :: a -> a -> Either a ()
eq a
s a
s' = if a
s forall a. Eq a => a -> a -> Bool
== a
s' then forall a b. b -> Either a b
Right () else forall a b. a -> Either a b
Left a
""

-- |
-- Try the given parsers in sequence. If all fail, fail with the given message,
-- and include the JSON in the error.
--
tryParse :: Text -> [Parse Text a] -> Parse Text a
tryParse :: forall a. Text -> [Parse Text a] -> Parse Text a
tryParse Text
msg =
  forall e (m :: * -> *) a. MonadError e m => m a -> [m a] -> m a
tryAll (forall (m :: * -> *) err a.
(Functor m, Monad m) =>
(Value -> Either err a) -> ParseT err m a
withValue (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
fullMsg forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Text
showJSON))

  where
  fullMsg :: Text
fullMsg = Text
"Invalid " forall a. Semigroup a => a -> a -> a
<> Text
msg forall a. Semigroup a => a -> a -> a
<> Text
": "

  showJSON :: A.Value -> Text
  showJSON :: Value -> Text
showJSON = ByteString -> Text
TE.decodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BS.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> ByteString
A.encode

-- |
-- This type is isomorphic to 'Maybe' 'ModuleName'. It makes code a bit
-- easier to read, as the meaning is more explicit.
--
data ContainingModule
  = ThisModule
  | OtherModule ModuleName
  deriving (Int -> ContainingModule -> ShowS
[ContainingModule] -> ShowS
ContainingModule -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ContainingModule] -> ShowS
$cshowList :: [ContainingModule] -> ShowS
show :: ContainingModule -> String
$cshow :: ContainingModule -> String
showsPrec :: Int -> ContainingModule -> ShowS
$cshowsPrec :: Int -> ContainingModule -> ShowS
Show, ContainingModule -> ContainingModule -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ContainingModule -> ContainingModule -> Bool
$c/= :: ContainingModule -> ContainingModule -> Bool
== :: ContainingModule -> ContainingModule -> Bool
$c== :: ContainingModule -> ContainingModule -> Bool
Eq, Eq ContainingModule
ContainingModule -> ContainingModule -> Bool
ContainingModule -> ContainingModule -> Ordering
ContainingModule -> ContainingModule -> ContainingModule
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 :: ContainingModule -> ContainingModule -> ContainingModule
$cmin :: ContainingModule -> ContainingModule -> ContainingModule
max :: ContainingModule -> ContainingModule -> ContainingModule
$cmax :: ContainingModule -> ContainingModule -> ContainingModule
>= :: ContainingModule -> ContainingModule -> Bool
$c>= :: ContainingModule -> ContainingModule -> Bool
> :: ContainingModule -> ContainingModule -> Bool
$c> :: ContainingModule -> ContainingModule -> Bool
<= :: ContainingModule -> ContainingModule -> Bool
$c<= :: ContainingModule -> ContainingModule -> Bool
< :: ContainingModule -> ContainingModule -> Bool
$c< :: ContainingModule -> ContainingModule -> Bool
compare :: ContainingModule -> ContainingModule -> Ordering
$ccompare :: ContainingModule -> ContainingModule -> Ordering
Ord)

instance A.ToJSON ContainingModule where
  toJSON :: ContainingModule -> Value
toJSON = forall a. ToJSON a => a -> Value
A.toJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContainingModule -> [Text]
go
    where
    go :: ContainingModule -> [Text]
go = \case
      ContainingModule
ThisModule -> [Text
"ThisModule"]
      OtherModule ModuleName
mn -> [Text
"OtherModule", ModuleName -> Text
runModuleName ModuleName
mn]

instance A.FromJSON ContainingModule where
  parseJSON :: Value -> Parser ContainingModule
parseJSON = forall err a. (err -> Text) -> Parse err a -> Value -> Parser a
toAesonParser forall a. a -> a
id Parse Text ContainingModule
asContainingModule

asContainingModule :: Parse Text ContainingModule
asContainingModule :: Parse Text ContainingModule
asContainingModule =
  forall a. Text -> [Parse Text a] -> Parse Text a
tryParse Text
"containing module" forall a b. (a -> b) -> a -> b
$
    [Parse Text ContainingModule]
current forall a. [a] -> [a] -> [a]
++ [Parse Text ContainingModule]
backwardsCompat
  where
  current :: [Parse Text ContainingModule]
current =
    [ forall a. Text -> Parse Text a -> Parse Text a
firstEq Text
"ThisModule" (forall (f :: * -> *) a. Applicative f => a -> f a
pure ContainingModule
ThisModule)
    , forall a. Text -> Parse Text a -> Parse Text a
firstEq Text
"OtherModule" (ModuleName -> ContainingModule
OtherModule forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Int -> ParseT err m a -> ParseT err m a
nth Int
1 forall {err}. ParseT err Identity ModuleName
asModuleName)
    ]

  -- For JSON produced by compilers up to 0.10.5.
  backwardsCompat :: [Parse Text ContainingModule]
backwardsCompat =
    [ Maybe ModuleName -> ContainingModule
maybeToContainingModule forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) err a.
(Functor m, Monad m) =>
ParseT err m a -> ParseT err m (Maybe a)
perhaps forall {err}. ParseT err Identity ModuleName
asModuleName
    ]

  asModuleName :: ParseT err Identity ModuleName
asModuleName = Text -> ModuleName
moduleNameFromString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) err. (Functor m, Monad m) => ParseT err m Text
asText

-- |
-- Convert a 'Maybe' 'ModuleName' to a 'ContainingModule', using the obvious
-- isomorphism.
--
maybeToContainingModule :: Maybe ModuleName -> ContainingModule
maybeToContainingModule :: Maybe ModuleName -> ContainingModule
maybeToContainingModule Maybe ModuleName
Nothing = ContainingModule
ThisModule
maybeToContainingModule (Just ModuleName
mn) = ModuleName -> ContainingModule
OtherModule ModuleName
mn

fromQualified :: Qualified a -> (ContainingModule, a)
fromQualified :: forall a. Qualified a -> (ContainingModule, a)
fromQualified (Qualified (ByModuleName ModuleName
mn) a
x) = (ModuleName -> ContainingModule
OtherModule ModuleName
mn, a
x)
fromQualified (Qualified QualifiedBy
_ a
x) = (ContainingModule
ThisModule, a
x)

data Link
  = NoLink
  | Link ContainingModule
  deriving (Int -> Link -> ShowS
[Link] -> ShowS
Link -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Link] -> ShowS
$cshowList :: [Link] -> ShowS
show :: Link -> String
$cshow :: Link -> String
showsPrec :: Int -> Link -> ShowS
$cshowsPrec :: Int -> Link -> ShowS
Show, Link -> Link -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Link -> Link -> Bool
$c/= :: Link -> Link -> Bool
== :: Link -> Link -> Bool
$c== :: Link -> Link -> Bool
Eq, Eq Link
Link -> Link -> Bool
Link -> Link -> Ordering
Link -> Link -> Link
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 :: Link -> Link -> Link
$cmin :: Link -> Link -> Link
max :: Link -> Link -> Link
$cmax :: Link -> Link -> Link
>= :: Link -> Link -> Bool
$c>= :: Link -> Link -> Bool
> :: Link -> Link -> Bool
$c> :: Link -> Link -> Bool
<= :: Link -> Link -> Bool
$c<= :: Link -> Link -> Bool
< :: Link -> Link -> Bool
$c< :: Link -> Link -> Bool
compare :: Link -> Link -> Ordering
$ccompare :: Link -> Link -> Ordering
Ord)

instance A.ToJSON Link where
  toJSON :: Link -> Value
toJSON = \case
    Link
NoLink -> forall a. ToJSON a => a -> Value
A.toJSON [Text
"NoLink" :: Text]
    Link ContainingModule
mn -> forall a. ToJSON a => a -> Value
A.toJSON [Value
"Link", forall a. ToJSON a => a -> Value
A.toJSON ContainingModule
mn]

asLink :: Parse Text Link
asLink :: Parse Text Link
asLink =
  forall a. Text -> [Parse Text a] -> Parse Text a
tryParse Text
"link"
    [ forall a. Text -> Parse Text a -> Parse Text a
firstEq Text
"NoLink" (forall (f :: * -> *) a. Applicative f => a -> f a
pure Link
NoLink)
    , forall a. Text -> Parse Text a -> Parse Text a
firstEq Text
"Link" (ContainingModule -> Link
Link forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Int -> ParseT err m a -> ParseT err m a
nth Int
1 Parse Text ContainingModule
asContainingModule)
    ]

instance A.FromJSON Link where
  parseJSON :: Value -> Parser Link
parseJSON = forall err a. (err -> Text) -> Parse err a -> Value -> Parser a
toAesonParser forall a. a -> a
id Parse Text Link
asLink

data Namespace
  = ValueLevel
  | TypeLevel
  deriving (Int -> Namespace -> ShowS
[Namespace] -> ShowS
Namespace -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Namespace] -> ShowS
$cshowList :: [Namespace] -> ShowS
show :: Namespace -> String
$cshow :: Namespace -> String
showsPrec :: Int -> Namespace -> ShowS
$cshowsPrec :: Int -> Namespace -> ShowS
Show, Namespace -> Namespace -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Namespace -> Namespace -> Bool
$c/= :: Namespace -> Namespace -> Bool
== :: Namespace -> Namespace -> Bool
$c== :: Namespace -> Namespace -> Bool
Eq, Eq Namespace
Namespace -> Namespace -> Bool
Namespace -> Namespace -> Ordering
Namespace -> Namespace -> Namespace
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 :: Namespace -> Namespace -> Namespace
$cmin :: Namespace -> Namespace -> Namespace
max :: Namespace -> Namespace -> Namespace
$cmax :: Namespace -> Namespace -> Namespace
>= :: Namespace -> Namespace -> Bool
$c>= :: Namespace -> Namespace -> Bool
> :: Namespace -> Namespace -> Bool
$c> :: Namespace -> Namespace -> Bool
<= :: Namespace -> Namespace -> Bool
$c<= :: Namespace -> Namespace -> Bool
< :: Namespace -> Namespace -> Bool
$c< :: Namespace -> Namespace -> Bool
compare :: Namespace -> Namespace -> Ordering
$ccompare :: Namespace -> Namespace -> Ordering
Ord, forall x. Rep Namespace x -> Namespace
forall x. Namespace -> Rep Namespace x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Namespace x -> Namespace
$cfrom :: forall x. Namespace -> Rep Namespace x
Generic)

instance NFData Namespace

instance A.ToJSON Namespace where
  toJSON :: Namespace -> Value
toJSON = forall a. ToJSON a => a -> Value
A.toJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show

asNamespace :: Parse Text Namespace
asNamespace :: Parse Text Namespace
asNamespace =
  forall a. Text -> [Parse Text a] -> Parse Text a
tryParse Text
"namespace"
    [ forall (m :: * -> *) err a.
(Functor m, Monad m) =>
(Text -> Either err a) -> ParseT err m a
withText forall a b. (a -> b) -> a -> b
$ \case
        Text
"ValueLevel" -> forall a b. b -> Either a b
Right Namespace
ValueLevel
        Text
"TypeLevel" -> forall a b. b -> Either a b
Right Namespace
TypeLevel
        Text
_ -> forall a b. a -> Either a b
Left Text
""
    ]

instance A.FromJSON Namespace where
  parseJSON :: Value -> Parser Namespace
parseJSON = forall err a. (err -> Text) -> Parse err a -> Value -> Parser a
toAesonParser forall a. a -> a
id Parse Text Namespace
asNamespace

-- |
-- A single element in a rendered code fragment. The intention is to support
-- multiple output formats. For example, plain text, or highlighted HTML.
--
data RenderedCodeElement
  = Syntax Text
  | Keyword Text
  | Space
  -- | Any symbol which you might or might not want to link to, in any
  -- namespace (value, type, or kind). Note that this is not related to the
  -- kind called Symbol for type-level strings.
  | Symbol Namespace Text Link
  | Role Text
  deriving (Int -> RenderedCodeElement -> ShowS
[RenderedCodeElement] -> ShowS
RenderedCodeElement -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RenderedCodeElement] -> ShowS
$cshowList :: [RenderedCodeElement] -> ShowS
show :: RenderedCodeElement -> String
$cshow :: RenderedCodeElement -> String
showsPrec :: Int -> RenderedCodeElement -> ShowS
$cshowsPrec :: Int -> RenderedCodeElement -> ShowS
Show, RenderedCodeElement -> RenderedCodeElement -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RenderedCodeElement -> RenderedCodeElement -> Bool
$c/= :: RenderedCodeElement -> RenderedCodeElement -> Bool
== :: RenderedCodeElement -> RenderedCodeElement -> Bool
$c== :: RenderedCodeElement -> RenderedCodeElement -> Bool
Eq, Eq RenderedCodeElement
RenderedCodeElement -> RenderedCodeElement -> Bool
RenderedCodeElement -> RenderedCodeElement -> Ordering
RenderedCodeElement -> RenderedCodeElement -> RenderedCodeElement
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 :: RenderedCodeElement -> RenderedCodeElement -> RenderedCodeElement
$cmin :: RenderedCodeElement -> RenderedCodeElement -> RenderedCodeElement
max :: RenderedCodeElement -> RenderedCodeElement -> RenderedCodeElement
$cmax :: RenderedCodeElement -> RenderedCodeElement -> RenderedCodeElement
>= :: RenderedCodeElement -> RenderedCodeElement -> Bool
$c>= :: RenderedCodeElement -> RenderedCodeElement -> Bool
> :: RenderedCodeElement -> RenderedCodeElement -> Bool
$c> :: RenderedCodeElement -> RenderedCodeElement -> Bool
<= :: RenderedCodeElement -> RenderedCodeElement -> Bool
$c<= :: RenderedCodeElement -> RenderedCodeElement -> Bool
< :: RenderedCodeElement -> RenderedCodeElement -> Bool
$c< :: RenderedCodeElement -> RenderedCodeElement -> Bool
compare :: RenderedCodeElement -> RenderedCodeElement -> Ordering
$ccompare :: RenderedCodeElement -> RenderedCodeElement -> Ordering
Ord)

instance A.ToJSON RenderedCodeElement where
  toJSON :: RenderedCodeElement -> Value
toJSON (Syntax Text
str) =
    forall a. ToJSON a => a -> Value
A.toJSON [Text
"syntax", Text
str]
  toJSON (Keyword Text
str) =
    forall a. ToJSON a => a -> Value
A.toJSON [Text
"keyword", Text
str]
  toJSON RenderedCodeElement
Space =
    forall a. ToJSON a => a -> Value
A.toJSON [Text
"space" :: Text]
  toJSON (Symbol Namespace
ns Text
str Link
link) =
    forall a. ToJSON a => a -> Value
A.toJSON [Value
"symbol", forall a. ToJSON a => a -> Value
A.toJSON Namespace
ns, forall a. ToJSON a => a -> Value
A.toJSON Text
str, forall a. ToJSON a => a -> Value
A.toJSON Link
link]
  toJSON (Role Text
role) =
    forall a. ToJSON a => a -> Value
A.toJSON [Text
"role", Text
role]

-- |
-- A type representing a highly simplified version of PureScript code, intended
-- for use in output formats like plain text or HTML.
--
newtype RenderedCode
  = RC { RenderedCode -> [RenderedCodeElement]
unRC :: [RenderedCodeElement] }
  deriving (Int -> RenderedCode -> ShowS
[RenderedCode] -> ShowS
RenderedCode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RenderedCode] -> ShowS
$cshowList :: [RenderedCode] -> ShowS
show :: RenderedCode -> String
$cshow :: RenderedCode -> String
showsPrec :: Int -> RenderedCode -> ShowS
$cshowsPrec :: Int -> RenderedCode -> ShowS
Show, RenderedCode -> RenderedCode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RenderedCode -> RenderedCode -> Bool
$c/= :: RenderedCode -> RenderedCode -> Bool
== :: RenderedCode -> RenderedCode -> Bool
$c== :: RenderedCode -> RenderedCode -> Bool
Eq, Eq RenderedCode
RenderedCode -> RenderedCode -> Bool
RenderedCode -> RenderedCode -> Ordering
RenderedCode -> RenderedCode -> RenderedCode
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 :: RenderedCode -> RenderedCode -> RenderedCode
$cmin :: RenderedCode -> RenderedCode -> RenderedCode
max :: RenderedCode -> RenderedCode -> RenderedCode
$cmax :: RenderedCode -> RenderedCode -> RenderedCode
>= :: RenderedCode -> RenderedCode -> Bool
$c>= :: RenderedCode -> RenderedCode -> Bool
> :: RenderedCode -> RenderedCode -> Bool
$c> :: RenderedCode -> RenderedCode -> Bool
<= :: RenderedCode -> RenderedCode -> Bool
$c<= :: RenderedCode -> RenderedCode -> Bool
< :: RenderedCode -> RenderedCode -> Bool
$c< :: RenderedCode -> RenderedCode -> Bool
compare :: RenderedCode -> RenderedCode -> Ordering
$ccompare :: RenderedCode -> RenderedCode -> Ordering
Ord, NonEmpty RenderedCode -> RenderedCode
RenderedCode -> RenderedCode -> RenderedCode
forall b. Integral b => b -> RenderedCode -> RenderedCode
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> RenderedCode -> RenderedCode
$cstimes :: forall b. Integral b => b -> RenderedCode -> RenderedCode
sconcat :: NonEmpty RenderedCode -> RenderedCode
$csconcat :: NonEmpty RenderedCode -> RenderedCode
<> :: RenderedCode -> RenderedCode -> RenderedCode
$c<> :: RenderedCode -> RenderedCode -> RenderedCode
Semigroup, Semigroup RenderedCode
RenderedCode
[RenderedCode] -> RenderedCode
RenderedCode -> RenderedCode -> RenderedCode
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [RenderedCode] -> RenderedCode
$cmconcat :: [RenderedCode] -> RenderedCode
mappend :: RenderedCode -> RenderedCode -> RenderedCode
$cmappend :: RenderedCode -> RenderedCode -> RenderedCode
mempty :: RenderedCode
$cmempty :: RenderedCode
Monoid)

instance A.ToJSON RenderedCode where
  toJSON :: RenderedCode -> Value
toJSON (RC [RenderedCodeElement]
elems) = forall a. ToJSON a => a -> Value
A.toJSON [RenderedCodeElement]
elems

-- |
-- This function allows conversion of a 'RenderedCode' value into a value of
-- some other type (for example, plain text, or HTML). The first argument
-- is a function specifying how each individual 'RenderedCodeElement' should be
-- rendered.
--
outputWith :: Monoid a => (RenderedCodeElement -> a) -> RenderedCode -> a
outputWith :: forall a.
Monoid a =>
(RenderedCodeElement -> a) -> RenderedCode -> a
outputWith RenderedCodeElement -> a
f = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap RenderedCodeElement -> a
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. RenderedCode -> [RenderedCodeElement]
unRC

-- |
-- A 'RenderedCode' fragment representing a space.
--
sp :: RenderedCode
sp :: RenderedCode
sp = [RenderedCodeElement] -> RenderedCode
RC [RenderedCodeElement
Space]

-- possible TODO: instead of this function, export RenderedCode values for
-- each syntax element, eg syntaxArr (== syntax "->"), syntaxLBrace,
-- syntaxRBrace, etc.
syntax :: Text -> RenderedCode
syntax :: Text -> RenderedCode
syntax Text
x = [RenderedCodeElement] -> RenderedCode
RC [Text -> RenderedCodeElement
Syntax Text
x]

keyword :: Text -> RenderedCode
keyword :: Text -> RenderedCode
keyword Text
kw = [RenderedCodeElement] -> RenderedCode
RC [Text -> RenderedCodeElement
Keyword Text
kw]

keywordForall :: RenderedCode
keywordForall :: RenderedCode
keywordForall = Text -> RenderedCode
keyword Text
"forall"

keywordData :: RenderedCode
keywordData :: RenderedCode
keywordData = Text -> RenderedCode
keyword Text
"data"

keywordType :: RenderedCode
keywordType :: RenderedCode
keywordType = Text -> RenderedCode
keyword Text
"type"

keywordClass :: RenderedCode
keywordClass :: RenderedCode
keywordClass = Text -> RenderedCode
keyword Text
"class"

keywordWhere :: RenderedCode
keywordWhere :: RenderedCode
keywordWhere = Text -> RenderedCode
keyword Text
"where"

keywordFixity :: Associativity -> RenderedCode
keywordFixity :: Associativity -> RenderedCode
keywordFixity Associativity
Infixl = Text -> RenderedCode
keyword Text
"infixl"
keywordFixity Associativity
Infixr = Text -> RenderedCode
keyword Text
"infixr"
keywordFixity Associativity
Infix = Text -> RenderedCode
keyword Text
"infix"

keywordAs :: RenderedCode
keywordAs :: RenderedCode
keywordAs = Text -> RenderedCode
keyword Text
"as"

ident :: Qualified Ident -> RenderedCode
ident :: Qualified Ident -> RenderedCode
ident (forall a. Qualified a -> (ContainingModule, a)
fromQualified -> (ContainingModule
mn, Ident
name)) =
  [RenderedCodeElement] -> RenderedCode
RC [Namespace -> Text -> Link -> RenderedCodeElement
Symbol Namespace
ValueLevel (Ident -> Text
runIdent Ident
name) (ContainingModule -> Link
Link ContainingModule
mn)]

dataCtor :: Qualified (ProperName 'ConstructorName) -> RenderedCode
dataCtor :: Qualified (ProperName 'ConstructorName) -> RenderedCode
dataCtor (forall a. Qualified a -> (ContainingModule, a)
fromQualified -> (ContainingModule
mn, ProperName 'ConstructorName
name)) =
  [RenderedCodeElement] -> RenderedCode
RC [Namespace -> Text -> Link -> RenderedCodeElement
Symbol Namespace
ValueLevel (forall (a :: ProperNameType). ProperName a -> Text
runProperName ProperName 'ConstructorName
name) (ContainingModule -> Link
Link ContainingModule
mn)]

typeCtor :: Qualified (ProperName 'TypeName) -> RenderedCode
typeCtor :: Qualified (ProperName 'TypeName) -> RenderedCode
typeCtor (forall a. Qualified a -> (ContainingModule, a)
fromQualified -> (ContainingModule
mn, ProperName 'TypeName
name)) =
  [RenderedCodeElement] -> RenderedCode
RC [Namespace -> Text -> Link -> RenderedCodeElement
Symbol Namespace
TypeLevel (forall (a :: ProperNameType). ProperName a -> Text
runProperName ProperName 'TypeName
name) (ContainingModule -> Link
Link ContainingModule
mn)]

typeOp :: Qualified (OpName 'TypeOpName) -> RenderedCode
typeOp :: Qualified (OpName 'TypeOpName) -> RenderedCode
typeOp (forall a. Qualified a -> (ContainingModule, a)
fromQualified -> (ContainingModule
mn, OpName 'TypeOpName
name)) =
  [RenderedCodeElement] -> RenderedCode
RC [Namespace -> Text -> Link -> RenderedCodeElement
Symbol Namespace
TypeLevel (forall (a :: OpNameType). OpName a -> Text
runOpName OpName 'TypeOpName
name) (ContainingModule -> Link
Link ContainingModule
mn)]

typeVar :: Text -> RenderedCode
typeVar :: Text -> RenderedCode
typeVar Text
x = [RenderedCodeElement] -> RenderedCode
RC [Namespace -> Text -> Link -> RenderedCodeElement
Symbol Namespace
TypeLevel Text
x Link
NoLink]

roleAnn :: Maybe Text -> RenderedCode
roleAnn :: Maybe Text -> RenderedCode
roleAnn = [RenderedCodeElement] -> RenderedCode
RC forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Text -> [RenderedCodeElement]
renderRole
  where
  renderRole :: Text -> [RenderedCodeElement]
renderRole = \case
    Text
"nominal" -> [Text -> RenderedCodeElement
Role Text
"nominal"]
    Text
"phantom" -> [Text -> RenderedCodeElement
Role Text
"phantom"]
    Text
_ -> []

type FixityAlias = Qualified (Either (ProperName 'TypeName) (Either Ident (ProperName 'ConstructorName)))

alias :: FixityAlias -> RenderedCode
alias :: FixityAlias -> RenderedCode
alias FixityAlias
for =
  RenderedCode
prefix forall a. Semigroup a => a -> a -> a
<> [RenderedCodeElement] -> RenderedCode
RC [Namespace -> Text -> Link -> RenderedCodeElement
Symbol Namespace
ns Text
name (ContainingModule -> Link
Link ContainingModule
mn)]
  where
  (Namespace
ns, Text
name, ContainingModule
mn) = FixityAlias -> (Namespace, Text, ContainingModule)
unpackFixityAlias FixityAlias
for
  prefix :: RenderedCode
prefix = case Namespace
ns of
    Namespace
TypeLevel ->
      RenderedCode
keywordType forall a. Semigroup a => a -> a -> a
<> RenderedCode
sp
    Namespace
_ ->
      forall a. Monoid a => a
mempty

aliasName :: FixityAlias -> Text -> RenderedCode
aliasName :: FixityAlias -> Text -> RenderedCode
aliasName FixityAlias
for Text
name' =
  let
    (Namespace
ns, Text
_, ContainingModule
_) = FixityAlias -> (Namespace, Text, ContainingModule)
unpackFixityAlias FixityAlias
for
    unParen :: Text -> Text
unParen = Text -> Text
T.tail forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.init
    name :: Text
name = Text -> Text
unParen Text
name'
  in
    case Namespace
ns of
      Namespace
ValueLevel ->
        Qualified Ident -> RenderedCode
ident (forall a. QualifiedBy -> a -> Qualified a
Qualified QualifiedBy
ByNullSourcePos (Text -> Ident
Ident Text
name))
      Namespace
TypeLevel ->
        Qualified (ProperName 'TypeName) -> RenderedCode
typeCtor (forall a. QualifiedBy -> a -> Qualified a
Qualified QualifiedBy
ByNullSourcePos (forall (a :: ProperNameType). Text -> ProperName a
ProperName Text
name))

-- | Converts a FixityAlias into a different representation which is more
-- useful to other functions in this module.
unpackFixityAlias :: FixityAlias -> (Namespace, Text, ContainingModule)
unpackFixityAlias :: FixityAlias -> (Namespace, Text, ContainingModule)
unpackFixityAlias (forall a. Qualified a -> (ContainingModule, a)
fromQualified -> (ContainingModule
mn, Either
  (ProperName 'TypeName) (Either Ident (ProperName 'ConstructorName))
x)) =
  case Either
  (ProperName 'TypeName) (Either Ident (ProperName 'ConstructorName))
x of
    -- We add some seemingly superfluous type signatures here just to be extra
    -- sure we are not mixing up our namespaces.
    Left (ProperName 'TypeName
n :: ProperName 'TypeName) ->
      (Namespace
TypeLevel, forall (a :: ProperNameType). ProperName a -> Text
runProperName ProperName 'TypeName
n, ContainingModule
mn)
    Right (Left Ident
n) ->
      (Namespace
ValueLevel, Ident -> Text
runIdent Ident
n, ContainingModule
mn)
    Right (Right (ProperName 'ConstructorName
n :: ProperName 'ConstructorName)) ->
      (Namespace
ValueLevel, forall (a :: ProperNameType). ProperName a -> Text
runProperName ProperName 'ConstructorName
n, ContainingModule
mn)