anoma/juvix
1
1
Fork 0
mirror of https://github.com/anoma/juvix.git synced 2025-01-07 16:22:14 +03:00
Code Issues Projects Releases Wiki Activity

Generate html documentation for alias and fixity definitions (#2327)

Browse Source 
![image](https://github.com/anoma/juvix/assets/5511599/91eb9f54-370b-4036-8aea-a39b1008b7f0)


![image](https://github.com/anoma/juvix/assets/5511599/abc0100b-5f7e-444e-adec-867707d03997)
This commit is contained in:
Jan Mas Rovira 2023-08-31 16:07:38 +02:00 committed by GitHub
parent afa5251418
commit 340f1927ae
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
5 changed files with 213 additions and 119 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
assets/css/source-ayu-light.css
View File

@ -44,7 +44,7 @@ body {
} }
.ju-fixity { .ju-fixity {
color: #3d4247; color: #ed9366;
} }
.ju-number { .ju-number {

10
assets/css/source-nord.css
View File

@ -32,23 +32,23 @@ body {
} }
.ju-var { .ju-var {
color: #d8dee9 color: #d8dee9;
} }
.ju-fixity { .ju-fixity {
color: #a4b4d2 color: #d08770;
} }
.ju-comment { .ju-comment {
color: #83898d color: #83898d;
} }
.ju-judoc { .ju-judoc {
color: #8fbcbb color: #8fbcbb;
} }
.ju-number { .ju-number {
color: #d8dee9 color: #d8dee9;
} }
.ju-define { .ju-define {

286
src/Juvix/Compiler/Backend/Html/Translation/FromTyped.hs
View File

@ -7,6 +7,7 @@ where
import Data.ByteString.Builder qualified as Builder import Data.ByteString.Builder qualified as Builder
import Data.HashMap.Strict qualified as HashMap import Data.HashMap.Strict qualified as HashMap
import Data.Text qualified as Text
import Data.Time.Clock import Data.Time.Clock
import Data.Versions (prettySemVer) import Data.Versions (prettySemVer)
import Juvix.Compiler.Backend.Html.Data import Juvix.Compiler.Backend.Html.Data
@ -22,6 +23,7 @@ import Juvix.Compiler.Internal.Translation.FromInternal.Analysis.ArityChecking.D
import Juvix.Compiler.Internal.Translation.FromInternal.Analysis.TypeChecking qualified as InternalTyped import Juvix.Compiler.Internal.Translation.FromInternal.Analysis.TypeChecking qualified as InternalTyped
import Juvix.Compiler.Internal.Translation.FromInternal.Analysis.TypeChecking.Data.Context import Juvix.Compiler.Internal.Translation.FromInternal.Analysis.TypeChecking.Data.Context
import Juvix.Compiler.Pipeline.EntryPoint import Juvix.Compiler.Pipeline.EntryPoint
import Juvix.Data.FixityInfo as FixityInfo
import Juvix.Extra.Assets import Juvix.Extra.Assets
import Juvix.Extra.Strings qualified as Str import Juvix.Extra.Strings qualified as Str
import Juvix.Prelude import Juvix.Prelude
@ -84,20 +86,22 @@ createIndexFile ps = do
indexHtml :: Sem r Html indexHtml :: Sem r Html
indexHtml = do indexHtml = do
tree' <- root tree tree' <- root tree
return $ return
Html.div ! Attr.id "content" $ $ Html.div
Html.div ! Attr.id "module-list" $ ! Attr.id "content"
(p ! Attr.class_ "caption" $ "Modules") $ Html.div
<> ( button ! Attr.id "module-list"
! Attr.id "toggle-all-button" $ (p ! Attr.class_ "caption" $ "Modules")
! Attr.class_ "toggle-button opened" <> ( button
! Attr.onclick "toggle()" ! Attr.id "toggle-all-button"
$ Html.span ! Attr.class_ "toggle-button opened"
! Attr.id "toggle-button-text" ! Attr.onclick "toggle()"
! Attr.class_ "toggle-icon" $ Html.span
$ "▼ Hide all modules" ! Attr.id "toggle-button-text"
) ! Attr.class_ "toggle-icon"
<> tree' $ "▼ Hide all modules"
)
<> tree'
tree :: ModuleTree tree :: ModuleTree
tree = indexTree ps tree = indexTree ps
@ -113,14 +117,16 @@ createIndexFile ps = do
nodeRow :: Sem r Html nodeRow :: Sem r Html
nodeRow = case lbl of nodeRow = case lbl of
Nothing -> Nothing ->
return $ return
Html.span ! Attr.class_ attrBare $ $ Html.span
toHtml (prettyText s) ! Attr.class_ attrBare
$ toHtml (prettyText s)
Just lbl' -> do Just lbl' -> do
lnk <- nameIdAttrRef lbl' Nothing lnk <- nameIdAttrRef lbl' Nothing
return $ return
Html.span ! Attr.class_ attrBare $ $ Html.span
(a ! Attr.href lnk $ toHtml (prettyText lbl')) ! Attr.class_ attrBare
$ (a ! Attr.href lnk $ toHtml (prettyText lbl'))
attrBase :: Html.AttributeValue attrBase :: Html.AttributeValue
attrBase = "details-toggle-control details-toggle" attrBase = "details-toggle-control details-toggle"
@ -136,10 +142,11 @@ createIndexFile ps = do
| null children = return row' | null children = return row'
| otherwise = do | otherwise = do
c' <- mapM (uncurry goChild) (HashMap.toList children) c' <- mapM (uncurry goChild) (HashMap.toList children)
return $ return
details ! Attr.open "open" $ $ details
summary row' ! Attr.open "open"
<> ul (mconcatMap li c') $ summary row'
<> ul (mconcatMap li c')
writeHtml :: (Members '[Embed IO] r) => Path Abs File -> Html -> Sem r () writeHtml :: (Members '[Embed IO] r) => Path Abs File -> Html -> Sem r ()
writeHtml f h = Prelude.embed $ do writeHtml f h = Prelude.embed $ do
@ -235,22 +242,27 @@ template rightMenu' content' = do
packageHeader = do packageHeader = do
pkgName' <- toHtml <$> asks (^. entryPointPackage . packageName) pkgName' <- toHtml <$> asks (^. entryPointPackage . packageName)
version' <- toHtml <$> asks (^. entryPointPackage . packageVersion . to prettySemVer) version' <- toHtml <$> asks (^. entryPointPackage . packageVersion . to prettySemVer)
return $ return
Html.div ! Attr.id "package-header" $ $ Html.div
( Html.span ! Attr.class_ "caption" $ ! Attr.id "package-header"
pkgName' <> " - " <> version' $ ( Html.span
! Attr.class_ "caption"
$ pkgName'
<> " - "
<> version'
) )
<> rightMenu' <> rightMenu'
mbody :: Sem r Html mbody :: Sem r Html
mbody = do mbody = do
bodyHeader' <- packageHeader bodyHeader' <- packageHeader
footer' <- htmlJuvixFooter footer' <- htmlJuvixFooter
return $ return
body ! Attr.class_ "js-enabled" $ $ body
bodyHeader' ! Attr.class_ "js-enabled"
<> content' $ bodyHeader'
<> footer' <> content'
<> footer'
body' <- mbody body' <- mbody
return $ docTypeHtml (mhead <> body') return $ docTypeHtml (mhead <> body')
@ -296,44 +308,53 @@ goTopModule cs m = do
rightMenu :: Sem s Html rightMenu :: Sem s Html
rightMenu = do rightMenu = do
sourceRef' <- local (set htmlOptionsKind HtmlSrc) (nameIdAttrRef tmp Nothing) sourceRef' <- local (set htmlOptionsKind HtmlSrc) (nameIdAttrRef tmp Nothing)
return $ return
ul ! Attr.id "page-menu" ! Attr.class_ "links" $ $ ul
li (a ! Attr.href sourceRef' $ "Source") -- TODO: review here ! Attr.id "page-menu"
<> li (a ! Attr.href (fromString (toFilePath indexFileName)) $ "Index") ! Attr.class_ "links"
$ li (a ! Attr.href sourceRef' $ "Source") -- TODO: review here
<> li (a ! Attr.href (fromString (toFilePath indexFileName)) $ "Index")
content :: Sem s Html content :: Sem s Html
content = do content = do
preface' <- docPreface preface' <- docPreface
interface' <- interface interface' <- interface
return $ return
Html.div ! Attr.id "content" $ $ Html.div
moduleHeader ! Attr.id "content"
<> toc $ moduleHeader
<> preface' <> toc
-- <> synopsis <> preface'
<> interface' -- <> synopsis
<> interface'
docPreface :: Sem s Html docPreface :: Sem s Html
docPreface = do docPreface = do
pref <- goJudocMay (m ^. moduleDoc) pref <- goJudocMay (m ^. moduleDoc)
return $ return
Html.div ! Attr.id "description" $ $ Html.div
Html.div ! Attr.class_ "doc" $ ! Attr.id "description"
( a ! Attr.id "sec:description" ! Attr.href "sec:description" $ $ Html.div
h1 "Description" ! Attr.class_ "doc"
) $ ( a
<> pref ! Attr.id "sec:description"
! Attr.href "sec:description"
$ h1 "Description"
)
<> pref
toc :: Html toc :: Html
toc = toc =
Html.div ! Attr.id "table-of-contents" $ Html.div
Html.div ! Attr.id "contents-list" $ ! Attr.id "table-of-contents"
( p $ Html.div
! Attr.id "contents-list"
$ ( p
! Attr.class_ "caption" ! Attr.class_ "caption"
! Attr.onclick "window.scrollTo(0,0)" ! Attr.onclick "window.scrollTo(0,0)"
$ "Contents" $ "Contents"
) )
<> tocEntries <> tocEntries
where where
tocEntries :: Html tocEntries :: Html
tocEntries = tocEntries =
@ -343,18 +364,22 @@ goTopModule cs m = do
moduleHeader :: Html moduleHeader :: Html
moduleHeader = moduleHeader =
Html.div ! Attr.id "module-header" $ Html.div
(p ! Attr.class_ "caption" $ toHtml (prettyText tmp)) ! Attr.id "module-header"
$ (p ! Attr.class_ "caption" $ toHtml (prettyText tmp))
interface :: Sem s Html interface :: Sem s Html
interface = do interface = do
sigs' <- mconcatMapM goStatement (m ^. moduleBody) sigs' <- mconcatMapM goStatement (m ^. moduleBody)
return $ return
Html.div ! Attr.id "interface" $ $ Html.div
( a ! Attr.id "sec:interface" ! Attr.href "sec:interface" $ ! Attr.id "interface"
h1 "Definitions" $ ( a
! Attr.id "sec:interface"
! Attr.href "sec:interface"
$ h1 "Definitions"
) )
<> sigs' <> sigs'
goJudocMay :: (Members '[Reader HtmlOptions, Reader NormalizedTable] r) => Maybe (Judoc 'Scoped) -> Sem r Html goJudocMay :: (Members '[Reader HtmlOptions, Reader NormalizedTable] r) => Maybe (Judoc 'Scoped) -> Sem r Html
goJudocMay = maybe (return mempty) goJudoc goJudocMay = maybe (return mempty) goJudoc
@ -382,29 +407,84 @@ goJudoc (Judoc bs) = mconcatMapM goGroup bs
goExample ex = do goExample ex = do
e' <- ppCodeHtml defaultOptions (ex ^. exampleExpression) e' <- ppCodeHtml defaultOptions (ex ^. exampleExpression)
norm' <- asks @NormalizedTable (^?! at (ex ^. exampleId) . _Just) >>= ppCodeHtmlInternal norm' <- asks @NormalizedTable (^?! at (ex ^. exampleId) . _Just) >>= ppCodeHtmlInternal
return $ return
Html.pre ! Attr.class_ "screen" $ $ Html.pre
(Html.code ! Attr.class_ "prompt" $ Str.judocExample) ! Attr.class_ "screen"
<> " " $ (Html.code ! Attr.class_ "prompt" $ Str.judocExample)
<> e' <> " "
<> "\n" <> e'
<> norm' <> "\n"
<> norm'
goAtom :: JudocAtom 'Scoped -> Sem r Html goAtom :: JudocAtom 'Scoped -> Sem r Html
goAtom = \case goAtom = \case
JudocExpression e -> ppCodeHtml defaultOptions e JudocExpression e -> ppCodeHtml defaultOptions e
JudocText txt -> return (toHtml txt) JudocText txt -> return (toHtml txt)
goStatement :: (Members '[Reader HtmlOptions, Reader NormalizedTable] r) => Statement 'Scoped -> Sem r Html goStatement :: forall r. (Members '[Reader HtmlOptions, Reader NormalizedTable] r) => Statement 'Scoped -> Sem r Html
goStatement = \case goStatement = \case
StatementAxiom t -> goAxiom t StatementAxiom t -> goAxiom t
StatementInductive t -> goInductive t StatementInductive t -> goInductive t
StatementOpenModule t -> goOpen t StatementOpenModule t -> goOpen t
StatementFunctionDef t -> goFunctionDef t StatementFunctionDef t -> goFunctionDef t
StatementSyntax {} -> mempty -- TODO handle alias StatementSyntax s -> goSyntax s
StatementImport {} -> mempty StatementImport {} -> mempty
StatementModule {} -> mempty -- TODO handle local modules StatementModule {} -> mempty -- TODO handle local modules
StatementProjectionDef {} -> mempty StatementProjectionDef {} -> mempty
where
goSyntax :: SyntaxDef 'Scoped -> Sem r Html
goSyntax = \case
SyntaxFixity f -> goFixity f
SyntaxAlias d -> goAlias d
SyntaxOperator {} -> mempty
SyntaxIterator {} -> mempty
goFixity :: forall r. (Members '[Reader HtmlOptions, Reader NormalizedTable] r) => FixitySyntaxDef 'Scoped -> Sem r Html
goFixity def = do
sig' <- ppHelper (ppFixityDefHeader def)
header' <- defHeader (def ^. fixitySymbol) sig' (def ^. fixityDoc)
let tbl' = table . tbody $ ari <> prec
return $
header'
<> ( Html.div
! Attr.class_ "subs"
$ (p ! Attr.class_ "caption" $ "Fixity details")
<> tbl'
)
where
info :: FixityInfo
info = def ^. fixityInfo . withLocParam . withSourceValue
row :: Html -> Html
row x = tr $ td ! Attr.class_ "src" $ x
prec :: Html
prec = case info ^. fixityPrecSame of
Just txt -> row $ toHtml ("Same precedence as " <> txt)
Nothing ->
goPrec "Higher" (info ^. fixityPrecAbove)
<> goPrec "Lower" (info ^. fixityPrecBelow)
where
goPrec :: Html -> [Text] -> Html
goPrec above ls = case nonEmpty ls of
Nothing -> mempty
Just l -> row $ above <> " precedence than: " <> toHtml (Text.intercalate ", " (toList l))
ari :: Html
ari =
let arit = toHtml @String $ show (info ^. FixityInfo.fixityArity)
assoc = toHtml @String $ case fromMaybe AssocNone (info ^. fixityAssoc) of
AssocNone -> ""
AssocRight -> ", right-associative"
AssocLeft -> ", left-associative"
in row $
arit
<> assoc
goAlias :: forall r. (Members '[Reader HtmlOptions, Reader NormalizedTable] r) => AliasDef 'Scoped -> Sem r Html
goAlias def = do
sig' <- ppCodeHtml defaultOptions def
defHeader (def ^. aliasDefName) sig' Nothing
goOpen :: forall r. (Members '[Reader HtmlOptions] r) => OpenModule 'Scoped -> Sem r Html goOpen :: forall r. (Members '[Reader HtmlOptions] r) => OpenModule 'Scoped -> Sem r Html
goOpen op goOpen op
@ -414,38 +494,26 @@ goOpen op
goAxiom :: forall r. (Members '[Reader HtmlOptions, Reader NormalizedTable] r) => AxiomDef 'Scoped -> Sem r Html goAxiom :: forall r. (Members '[Reader HtmlOptions, Reader NormalizedTable] r) => AxiomDef 'Scoped -> Sem r Html
goAxiom axiom = do goAxiom axiom = do
header' <- axiomHeader header' <- axiomHeader
defHeader tmp uid header' (axiom ^. axiomDoc) defHeader (axiom ^. axiomName) header' (axiom ^. axiomDoc)
where where
uid :: NameId
uid = axiom ^. axiomName . S.nameId
tmp :: TopModulePath
tmp = axiom ^. axiomName . S.nameDefinedIn . S.absTopModulePath
axiomHeader :: Sem r Html axiomHeader :: Sem r Html
axiomHeader = ppCodeHtml defaultOptions (set axiomDoc Nothing axiom) axiomHeader = ppCodeHtml defaultOptions (set axiomDoc Nothing axiom)
goFunctionDef :: forall r. (Members '[Reader HtmlOptions, Reader NormalizedTable] r) => FunctionDef 'Scoped -> Sem r Html goFunctionDef :: forall r. (Members '[Reader HtmlOptions, Reader NormalizedTable] r) => FunctionDef 'Scoped -> Sem r Html
goFunctionDef def = do goFunctionDef def = do
sig' <- funSig sig' <- funSig
defHeader tmp uid sig' (def ^. signDoc) defHeader (def ^. signName) sig' (def ^. signDoc)
where where
uid :: NameId
uid = def ^. signName . S.nameId
tmp :: TopModulePath
tmp = def ^. signName . S.nameDefinedIn . S.absTopModulePath
funSig :: Sem r Html funSig :: Sem r Html
funSig = ppHelper (ppFunctionSignature def) funSig = ppHelper (ppFunctionSignature def)
goInductive :: forall r. (Members '[Reader HtmlOptions, Reader NormalizedTable] r) => InductiveDef 'Scoped -> Sem r Html goInductive :: forall r. (Members '[Reader HtmlOptions, Reader NormalizedTable] r) => InductiveDef 'Scoped -> Sem r Html
goInductive def = do goInductive def = do
sig' <- inductiveHeader sig' <- inductiveHeader
header' <- defHeader tmp uid sig' (def ^. inductiveDoc) header' <- defHeader (def ^. inductiveName) sig' (def ^. inductiveDoc)
body' <- goConstructors (def ^. inductiveConstructors) body' <- goConstructors (def ^. inductiveConstructors)
return (header' <> body') return (header' <> body')
where where
uid :: NameId
uid = def ^. inductiveName . S.nameId
tmp :: TopModulePath
tmp = def ^. inductiveName . S.nameDefinedIn . S.absTopModulePath
inductiveHeader :: Sem r Html inductiveHeader :: Sem r Html
inductiveHeader = ppHelper (ppInductiveSignature def) inductiveHeader = ppHelper (ppInductiveSignature def)
@ -455,10 +523,11 @@ ppHelper = docToHtml . run . runReader defaultOptions . execExactPrint Nothing
goConstructors :: forall r. (Members '[Reader HtmlOptions, Reader NormalizedTable] r) => NonEmpty (ConstructorDef 'Scoped) -> Sem r Html goConstructors :: forall r. (Members '[Reader HtmlOptions, Reader NormalizedTable] r) => NonEmpty (ConstructorDef 'Scoped) -> Sem r Html
goConstructors cc = do goConstructors cc = do
tbl' <- table . tbody <$> mconcatMapM goConstructor cc tbl' <- table . tbody <$> mconcatMapM goConstructor cc
return $ return
Html.div ! Attr.class_ "subs constructors" $ $ Html.div
(p ! Attr.class_ "caption" $ "Constructors") ! Attr.class_ "subs constructors"
<> tbl' $ (p ! Attr.class_ "caption" $ "Constructors")
<> tbl'
where where
goConstructor :: ConstructorDef 'Scoped -> Sem r Html goConstructor :: ConstructorDef 'Scoped -> Sem r Html
goConstructor c = do goConstructor c = do
@ -468,28 +537,43 @@ goConstructors cc = do
where where
docPart :: Sem r Html docPart :: Sem r Html
docPart = do docPart = do
td ! Attr.class_ "doc" td
! Attr.class_ "doc"
<$> goJudocMay (c ^. constructorDoc) <$> goJudocMay (c ^. constructorDoc)
srcPart :: Sem r Html srcPart :: Sem r Html
srcPart = do srcPart = do
sig' <- ppCodeHtml defaultOptions (set constructorDoc Nothing c) sig' <- ppCodeHtml defaultOptions (set constructorDoc Nothing c)
return $ return
td ! Attr.class_ "src" $ $ td
sig' ! Attr.class_ "src"
$ sig'
noDefHeader :: Html -> Html noDefHeader :: Html -> Html
noDefHeader = p ! Attr.class_ "src" noDefHeader = p ! Attr.class_ "src"
defHeader :: forall r. (Members '[Reader HtmlOptions, Reader NormalizedTable] r) => TopModulePath -> NameId -> Html -> Maybe (Judoc 'Scoped) -> Sem r Html defHeader ::
defHeader tmp uid sig mjudoc = do forall r x.
(Members '[Reader HtmlOptions, Reader NormalizedTable] r) =>
S.Name' x ->
Html ->
Maybe (Judoc 'Scoped) ->
Sem r Html
defHeader name sig mjudoc = do
funHeader' <- functionHeader funHeader' <- functionHeader
judoc' <- judoc judoc' <- judoc
return $ return
Html.div ! Attr.class_ "top" $ $ Html.div
funHeader' ! Attr.class_ "top"
<> judoc' $ funHeader'
<> judoc'
where where
uid :: NameId
uid = name ^. S.nameId
tmp :: TopModulePath
tmp = name ^. S.nameDefinedIn . S.absTopModulePath
judoc :: Sem r Html judoc :: Sem r Html
judoc = do judoc = do
judoc' <- goJudocMay mjudoc judoc' <- goJudocMay mjudoc

15
src/Juvix/Compiler/Concrete/Print/Base.hs
View File

@ -596,16 +596,21 @@ instance PrettyPrint Precedence where
PrecApp -> noLoc (pretty ("ω" :: Text)) PrecApp -> noLoc (pretty ("ω" :: Text))
PrecUpdate -> noLoc (pretty ("ω₁" :: Text)) PrecUpdate -> noLoc (pretty ("ω₁" :: Text))
ppFixityDefHeader :: (SingI s) => PrettyPrinting (FixitySyntaxDef s)
ppFixityDefHeader FixitySyntaxDef {..} = do
let sym' = annotated (AnnKind KNameFixity) (ppSymbolType _fixitySymbol)
ppCode _fixitySyntaxKw <+> ppCode _fixityKw <+> sym'
instance (SingI s) => PrettyPrint (FixitySyntaxDef s) where instance (SingI s) => PrettyPrint (FixitySyntaxDef s) where
ppCode FixitySyntaxDef {..} = do ppCode f@FixitySyntaxDef {..} = do
let sym' = ppSymbolType _fixitySymbol let header' = ppFixityDefHeader f
let txt = pretty (_fixityInfo ^. withLocParam . withSourceText) txt = pretty (_fixityInfo ^. withLocParam . withSourceText)
ppCode _fixitySyntaxKw <+> ppCode _fixityKw <+> sym' <+> braces (noLoc txt) header' <+> braces (noLoc txt)
instance PrettyPrint OperatorSyntaxDef where instance PrettyPrint OperatorSyntaxDef where
ppCode OperatorSyntaxDef {..} = do ppCode OperatorSyntaxDef {..} = do
let opSymbol' = ppUnkindedSymbol _opSymbol let opSymbol' = ppUnkindedSymbol _opSymbol
let p = ppUnkindedSymbol _opFixity p = ppUnkindedSymbol _opFixity
ppCode _opSyntaxKw <+> ppCode _opKw <+> opSymbol' <+> p ppCode _opSyntaxKw <+> ppCode _opKw <+> opSymbol' <+> p
instance PrettyPrint PatternApp where instance PrettyPrint PatternApp where

19
src/Juvix/Data/FixityInfo.hs
View File

@ -1,17 +1,22 @@
module Juvix.Data.FixityInfo where module Juvix.Data.FixityInfo
( module Juvix.Data.FixityInfo,
module Juvix.Data.Fixity,
)
where
import Juvix.Data.Fixity (BinaryAssoc (..))
import Juvix.Data.Yaml import Juvix.Data.Yaml
import Juvix.Prelude.Base import Juvix.Prelude.Base
data Arity = Unary | Binary data Arity
deriving stock (Show, Eq, Ord, Generic) = Unary
| Binary
data Assoc = AssocLeft | AssocRight | AssocNone
deriving stock (Show, Eq, Ord, Generic) deriving stock (Show, Eq, Ord, Generic)
-- TODO consider using sum type for Same | Below && Above
data FixityInfo = FixityInfo data FixityInfo = FixityInfo
{ _fixityArity :: Arity, { _fixityArity :: Arity,
_fixityAssoc :: Maybe Assoc, _fixityAssoc :: Maybe BinaryAssoc,
_fixityPrecSame :: Maybe Text, _fixityPrecSame :: Maybe Text,
_fixityPrecBelow :: [Text], _fixityPrecBelow :: [Text],
_fixityPrecAbove :: [Text] _fixityPrecAbove :: [Text]
@ -43,7 +48,7 @@ instance FromJSON FixityInfo where
"binary" -> return Binary "binary" -> return Binary
_ -> throwCustomError "unknown arity" _ -> throwCustomError "unknown arity"
parseAssoc :: Parse YamlError Assoc parseAssoc :: Parse YamlError BinaryAssoc
parseAssoc = do parseAssoc = do
txt <- asText txt <- asText
case txt of case txt of