module Language.PureScript.Docs.RenderedCode.Types
( RenderedCodeElement(..)
, asRenderedCodeElement
, ContainingModule(..)
, asContainingModule
, containingModuleToMaybe
, maybeToContainingModule
, fromContainingModule
, RenderedCode
, asRenderedCode
, outputWith
, sp
, syntax
, ident
, ident'
, ctor
, kind
, keyword
, keywordForall
, keywordData
, keywordNewtype
, keywordType
, keywordClass
, keywordInstance
, keywordWhere
, keywordFixity
) where
import Prelude.Compat
import Control.Monad.Error.Class (MonadError(..))
import Data.Aeson.BetterErrors
import qualified Data.Aeson as A
import qualified Language.PureScript as P
data RenderedCodeElement
= Syntax String
| Ident String ContainingModule
| Ctor String ContainingModule
| Kind String
| Keyword String
| Space
deriving (Show, Eq, Ord)
instance A.ToJSON RenderedCodeElement where
toJSON (Syntax str) =
A.toJSON ["syntax", str]
toJSON (Ident str mn) =
A.toJSON ["ident", A.toJSON str, A.toJSON mn]
toJSON (Ctor str mn) =
A.toJSON ["ctor", A.toJSON str, A.toJSON mn ]
toJSON (Kind str) =
A.toJSON ["kind", str]
toJSON (Keyword str) =
A.toJSON ["keyword", str]
toJSON Space =
A.toJSON ["space" :: String]
asRenderedCodeElement :: Parse String RenderedCodeElement
asRenderedCodeElement =
a Syntax "syntax" <|>
asIdent <|>
asCtor <|>
a Kind "kind" <|>
a Keyword "keyword" <|>
asSpace <|>
unableToParse
where
p <|> q = catchError p (const q)
a ctor' ctorStr = ctor' <$> (nth 0 (withString (eq ctorStr)) *> nth 1 asString)
asIdent = nth 0 (withString (eq "ident")) *> (Ident <$> nth 1 asString <*> nth 2 asContainingModule)
asCtor = nth 0 (withString (eq "ctor")) *> (Ctor <$> nth 1 asString <*> nth 2 asContainingModule)
asSpace = nth 0 (withString (eq "space")) *> pure Space
eq s s' = if s == s' then Right () else Left ""
unableToParse = withString (Left . show)
data ContainingModule
= ThisModule
| OtherModule P.ModuleName
deriving (Show, Eq, Ord)
instance A.ToJSON ContainingModule where
toJSON mn = A.toJSON (P.runModuleName <$> containingModuleToMaybe mn)
asContainingModule :: Parse e ContainingModule
asContainingModule =
maybeToContainingModule <$> perhaps (P.moduleNameFromString <$> asString)
maybeToContainingModule :: Maybe P.ModuleName -> ContainingModule
maybeToContainingModule Nothing = ThisModule
maybeToContainingModule (Just mn) = OtherModule mn
containingModuleToMaybe :: ContainingModule -> Maybe P.ModuleName
containingModuleToMaybe ThisModule = Nothing
containingModuleToMaybe (OtherModule mn) = Just mn
fromContainingModule :: P.ModuleName -> ContainingModule -> P.ModuleName
fromContainingModule def ThisModule = def
fromContainingModule _ (OtherModule mn) = mn
newtype RenderedCode
= RC { unRC :: [RenderedCodeElement] }
deriving (Show, Eq, Ord, Monoid)
instance A.ToJSON RenderedCode where
toJSON (RC elems) = A.toJSON elems
asRenderedCode :: Parse String RenderedCode
asRenderedCode = RC <$> eachInArray asRenderedCodeElement
outputWith :: Monoid a => (RenderedCodeElement -> a) -> RenderedCode -> a
outputWith f = foldMap f . unRC
sp :: RenderedCode
sp = RC [Space]
syntax :: String -> RenderedCode
syntax x = RC [Syntax x]
ident :: String -> RenderedCode
ident x = RC [Ident x ThisModule]
ident' :: String -> ContainingModule -> RenderedCode
ident' x m = RC [Ident x m]
ctor :: String -> ContainingModule -> RenderedCode
ctor x m = RC [Ctor x m]
kind :: String -> RenderedCode
kind x = RC [Kind x]
keyword :: String -> RenderedCode
keyword kw = RC [Keyword kw]
keywordForall :: RenderedCode
keywordForall = keyword "forall"
keywordData :: RenderedCode
keywordData = keyword "data"
keywordNewtype :: RenderedCode
keywordNewtype = keyword "newtype"
keywordType :: RenderedCode
keywordType = keyword "type"
keywordClass :: RenderedCode
keywordClass = keyword "class"
keywordInstance :: RenderedCode
keywordInstance = keyword "instance"
keywordWhere :: RenderedCode
keywordWhere = keyword "where"
keywordFixity :: P.Associativity -> RenderedCode
keywordFixity P.Infixl = keyword "infixl"
keywordFixity P.Infixr = keyword "infixr"
keywordFixity P.Infix = keyword "infix"