diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,5 @@ +0.0.3 +=== + +- bump for numhask-0.11 changes +- pragma cleanup diff --git a/dotparse.cabal b/dotparse.cabal --- a/dotparse.cabal +++ b/dotparse.cabal @@ -1,23 +1,22 @@ -cabal-version: 2.4 +cabal-version: 3.0 name: dotparse -version: 0.0.2 +version: 0.0.3 synopsis: dot language parsing and printing. description: This package provides parsing and printing of the dot language. - . == Usage - . + >>> :set -XOverloadedLabels >>> :set -XOverloadedStrings >>> import DotParse >>> import Chart >>> import DotParse.Examples (exInt) >>> ex <- processGraph exInt - >>> writeChartOptions "other/ex.svg" (graphToChartWith defaultChartConfig ex) - . - ![usage example](docs/other/ex.svg) - . + >>> writeChartOptions "other/exga.svg" (graphToChartWith defaultChartConfig ex) + ![usage example](docs/other/exga.svg) + + category: project author: Tony Day maintainer: tonyday567@gmail.com @@ -27,26 +26,91 @@ bug-reports: https://github.com/tonyday567/dotparse/issues build-type: Simple extra-doc-files: other/*.svg + ChangeLog.md + readme.org source-repository head type: git location: https://github.com/tonyday567/dotparse -library - hs-source-dirs: src - default-extensions: +common ghc2021-stanza + if impl(ghc >=9.2) + default-language: + GHC2021 + if impl(ghc <9.2) + default-language: + Haskell2010 + default-extensions: + BangPatterns + BinaryLiterals + ConstrainedClassMethods + ConstraintKinds + DeriveDataTypeable + DeriveFoldable + DeriveFunctor + DeriveGeneric + DeriveLift + DeriveTraversable + DoAndIfThenElse + EmptyCase + EmptyDataDecls + EmptyDataDeriving + ExistentialQuantification + ExplicitForAll + FlexibleContexts + FlexibleInstances + ForeignFunctionInterface + GADTSyntax + GeneralisedNewtypeDeriving + HexFloatLiterals + ImplicitPrelude + InstanceSigs + KindSignatures + MonomorphismRestriction + MultiParamTypeClasses + NamedFieldPuns + NamedWildCards + NumericUnderscores + PatternGuards + PolyKinds + PostfixOperators + RankNTypes + RelaxedPolyRec + ScopedTypeVariables + StandaloneDeriving + StarIsType + TraditionalRecordSyntax + TupleSections + TypeApplications + TypeOperators + TypeSynonymInstances + if impl(ghc <9.2) && impl(ghc >=8.10) + default-extensions: + ImportQualifiedPost + StandaloneKindSignatures + +common ghc-options-stanza ghc-options: - -Wall -Wcompat -Wincomplete-record-updates - -Wincomplete-uni-patterns -Wredundant-constraints + -Wall + -Wcompat + -Wincomplete-record-updates + -Wincomplete-uni-patterns + -Wredundant-constraints + -Widentities + -Wpartial-fields +library + import: ghc2021-stanza + import: ghc-options-stanza + hs-source-dirs: src build-depends: , algebraic-graphs >=0.6 && <0.8 - , base >=4.7 && <5 - , bytestring ^>=0.11.3 + , base >=4.7 && <5 + , bytestring >=0.11.3 && <0.13 , chart-svg >=0.3 && < 0.5 , containers ^>=0.6 - , flatparse >=0.3.2 && <0.5 - , numhask-space ^>=0.10 + , flatparse >=0.3.2 && <0.6 + , numhask-space >=0.10 && <0.12 , optics-core ^>=0.4 , process-extras ^>=0.7.4 , string-interpolate ^>=0.3 @@ -61,6 +125,3 @@ DotParse.FlatParse DotParse.FlatParse.TH DotParse.Types - - other-modules: - default-language: Haskell2010 diff --git a/other/nh.svg b/other/nh.svg --- a/other/nh.svg +++ b/other/nh.svg @@ -1,4 +1,4 @@ -ActionsAdditiveBasisDirectionDistributiveDivisiveExpFieldFieldIntegralMultiplicativeQuotientFieldRatioRingSubtractiveTrigField diff --git a/readme.org b/readme.org new file mode 100644 --- /dev/null +++ b/readme.org @@ -0,0 +1,287 @@ +#+TITLE: dotparse + +[[https://hackage.haskell.org/package/dotparse][file:https://img.shields.io/hackage/v/dotparse.svg]] + +* Introduction + +Parsing and printing for the dot language of graphviz. + +- A close rendition of the [[http://www.graphviz.org/doc/info/lang.html][dot language specification]] +- Supports inexact printing . parsing round trip; forgetting comments, separator choice and whitespace. +- Treats attribute keys and values as ByteStrings. No Type safety of Attributes is attempted. +- Uses command-line graphviz programs `dot` and `neato` to augment dot graph specifications +- Supports conversion from and to [[https://hackage.haskell.org/package/algebraic-graphs][algebraic-graphs]]. +- Support rendering dot graphs using [[https://hackage.haskell.org/package/chart-svg][chart-svg]]. +- Uses [[https://hackage.haskell.org/package/flatparse][flatparse]] for speedy parsing. + +** Reference + +Graphviz documentation: + +[[https://www.graphviz.org/][Graphviz Main Page]] + +[[http://magjac.com/graphviz-visual-editor/][Graphviz Visual Editor]] + +[[http://www.graphviz.org/doc/info/attrs.html][Attributes | Graphviz]] + +[[http://www.graphviz.org/pdf/dot.1.pdf][Dot Grammar]] + +Graphviz practical examples: + +https://renenyffenegger.ch/notes/tools/Graphviz/examples/index + +https://renenyffenegger.ch/notes/tools/Graphviz/attributes/label/HTML-like/index + +** Similar projects + +The [[https://hackage.haskell.org/package/graphviz][graphviz]] library aims for comprehensive typing of graphviz attributes and syntax. As a result, it is quite large and somewhat incomplete. In contrast, dotparse parsing is simpler, more robust and faster. It is also somewhat tied to fgl and I wanted to try a different graph library. + +[[https://hackage.haskell.org/package/dotgen][dotgen]] is a dot graph printer but not a parser. It supports a monadic style of printing. Specifically, it supports generation of unique names if that is an important feature of the problem domain. + +** development wish list + +Target [[https://hackage.haskell.org/package/calligraphy][calligraphy]] for enhanced source code visualization. + +Broaden support to include fgl and containers. + +Support parsing of library graphs from cabal. + +Explore [[https://kowainik.github.io/posts/2019-01-14-tomland#tagged-partial-bidirectional-isomorphism][tagged partial birectional isomorphism]] style. + +Steal design ideas from [[https://hackage.haskell.org/package/jordan][jordan]]. + +Case-insensitive parsing blocked on [[https://github.com/AndrasKovacs/flatparse/issues/10][AndrasKovacs/flatparse#10 Case-insensitive keyword matching]]. + +Exact printing of comments and whitespace. + +* process pipelines + +** algebraic-graphs +Starting with a Graph from algebraic-graphs: + +#+begin_src haskell +import qualified Algebra.Graph as G +:{ +exAGraph :: G.Graph Int +exAGraph = + G.edges $ + [(v, (v + 1) `mod` 6) | v <- [0 .. 5]] + <> [(v, v + k) | v <- [0 .. 5], k <- [6, 12]] + <> [(2, 18), (2, 19), (15, 18), (15, 19), (18, 3), (19, 3)] +:} +#+end_src + +#+RESULTS: +: ghci| ghci| ghci| ghci| ghci| ghci| ghci| + +#+begin_src haskell :results output :exports both +exAGraph +#+end_src + +#+RESULTS: +: Overlay (Connect (Vertex 0) (Vertex 1)) (Overlay (Connect (Vertex 1) (Vertex 2)) (Overlay (Connect (Vertex 2) (Vertex 3)) (Overlay (Connect (Vertex 3) (Vertex 4)) (Overlay (Connect (Vertex 4) (Vertex 5)) (Overlay (Connect (Vertex 5) (Vertex 0)) (Overlay (Connect (Vertex 0) (Vertex 6)) (Overlay (Connect (Vertex 0) (Vertex 12)) (Overlay (Connect (Vertex 1) (Vertex 7)) (Overlay (Connect (Vertex 1) (Vertex 13)) (Overlay (Connect (Vertex 2) (Vertex 8)) (Overlay (Connect (Vertex 2) (Vertex 14)) (Overlay (Connect (Vertex 3) (Vertex 9)) (Overlay (Connect (Vertex 3) (Vertex 15)) (Overlay (Connect (Vertex 4) (Vertex 10)) (Overlay (Connect (Vertex 4) (Vertex 16)) (Overlay (Connect (Vertex 5) (Vertex 11)) (Overlay (Connect (Vertex 5) (Vertex 17)) (Overlay (Connect (Vertex 2) (Vertex 18)) (Overlay (Connect (Vertex 2) (Vertex 19)) (Overlay (Connect (Vertex 15) (Vertex 18)) (Overlay (Connect (Vertex 15) (Vertex 19)) (Overlay (Connect (Vertex 18) (Vertex 3)) (Connect (Vertex 19) (Vertex 3)))))))))))))))))))))))) + +** dotparse Graph + +Convert to a dotparse Graph + +#+begin_src haskell +exGraph = defaultGraph & addStatements (toStatements Directed (Char8.pack . show <$> exAGraph)) +#+end_src + +** dotPrint + +Encode graph as a ByteString (prior to processing via graphviz) + +#+begin_src haskell :results output :exports both +BS.putStr (dotPrint defaultDotConfig exGraph) +#+end_src + +#+RESULTS: +#+begin_example +digraph { + node [height=0.5;shape=circle] + graph [overlap=false;size="1!";splines=spline] + edge [arrowsize=0.5] + "9" + "8" + "7" + "6" + "5" + "4" + "3" + "2" + "19" + "18" + "17" + "16" + "15" + "14" + "13" + "12" + "11" + "10" + "1" + "0" + "5" -> "17" + "5" -> "11" + "5" -> "0" + "4" -> "5" + "4" -> "16" + "4" -> "10" + "3" -> "9" + "3" -> "4" + "3" -> "15" + "2" -> "8" + "2" -> "3" + "2" -> "19" + "2" -> "18" + "2" -> "14" + "19" -> "3" + "18" -> "3" + "15" -> "19" + "15" -> "18" + "1" -> "7" + "1" -> "2" + "1" -> "13" + "0" -> "6" + "0" -> "12" + "0" -> "1" + } +#+end_example + +** processDotWith + +Directly create an SVG from the dotparse Graph + +#+begin_src haskell :file other/exdirect.svg :results output graphics file :exports both +(\b f -> processDotWith Directed ["-Tsvg", "-o", "other/" <> f <> ".svg"] b) (dotPrint defaultDotConfig exGraph) "exdirect" + #+end_src + +#+RESULTS: +[[file:other/exdirect.svg]] + +** processDot + +ByteString of the processed Graph + + #+begin_src haskell :results output +BS.putStr =<< processDot Directed (dotPrint defaultDotConfig exInt) + #+end_src + +** processGraph + +Graph augmented by graphviz + +#+begin_src haskell +exGraphAugmented <- processGraph exGraph +:t exGraphAugmented +#+end_src + +#+RESULTS: +: exGraphAugmented :: Graph + +** graphToChartWith + +SVG production via chart-svg + +#+begin_src haskell :file other/exga.svg :results output graphics file :exports both +import Chart (writeChartOptions) +writeChartOptions "other/exga.svg" (graphToChartWith defaultChartConfig exGraphAugmented) +#+end_src + +#+RESULTS: +[[file:other/exga.svg]] + +* Development + +** imports + +#+begin_src haskell :results output +:reload +:set prompt "> " +:set -XOverloadedLabels +:set -XOverloadedStrings +:set -Wno-type-defaults +:set -XImportQualifiedPost +import Chart +import Optics.Core +import FlatParse.Basic qualified as FP +import qualified Data.ByteString as BS +import qualified Data.ByteString.Char8 as Char8 +import GHC.Exts +import DotParse +import DotParse.Examples +import DotParse.Examples.NumHask +import Data.Proxy +print "ok" +#+end_src + +#+RESULTS: +: [3 of 6] Compiling DotParse.Types ( src/DotParse/Types.hs, interpreted ) [Source file changed] +: [5 of 6] Compiling DotParse.Examples.NumHask ( src/DotParse/Examples/NumHask.hs, interpreted ) [Source file changed] +: Ok, six modules loaded. +: > +: ok + +** write examples + +Round-trip test + +#+begin_src haskell :results output +testAll +#+end_src + +#+RESULTS: +#+begin_example +ex0 +ex1 +ex2 +ex3 +ex4 +ex5 +ex6 +ex7 +ex8 +ex9 +ex10 +ex11 +ex12 +ex13 +ex14 +ex15 +#+end_example + +Render examples + +#+begin_src haskell +svgAll +#+end_src + +#+RESULTS: +#+begin_example +ex0 +ex1 +ex2 +ex3 +ex4 +ex5 +ex6 +ex7 +ex8 +ex9 +ex10 +ex11 +ex12 +ex13 +ex14 +ex15 +#+end_example + +** numhask example + + #+begin_src haskell +writeNHChart + #+end_src + +This is bugged downstream as chart-svg uses the link string (which is very long compared with the displayed text) to estimate the bounding box and results in a very wide chart with a lot of white space either side. diff --git a/src/DotParse.hs b/src/DotParse.hs --- a/src/DotParse.hs +++ b/src/DotParse.hs @@ -1,20 +1,14 @@ -{-# LANGUAGE AllowAmbiguousTypes #-} -{-# LANGUAGE BlockArguments #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE ScopedTypeVariables #-} {-# OPTIONS_HADDOCK prune #-} -- | Parser & Printer for the dot language of -- -- See "DotParse.Examples" for usage. module DotParse - ( - DotConfig(..), + ( DotConfig (..), defaultDotConfig, DotParse (..), testDotParser, runDotParser, - Graph (..), defaultGraph, attL, @@ -23,12 +17,11 @@ processDotWith, processGraph, processGraphWith, - - Strict(..), + Strict (..), defStrict, - Directed(..), + Directed (..), defDirected, - ID(..), + ID (..), label, Compass (..), Port (..), @@ -55,7 +48,6 @@ toStatements, toDotGraph, toDotGraphWith, - ) where diff --git a/src/DotParse/Examples.hs b/src/DotParse/Examples.hs --- a/src/DotParse/Examples.hs +++ b/src/DotParse/Examples.hs @@ -1,30 +1,21 @@ -{-# LANGUAGE AllowAmbiguousTypes #-} -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE BlockArguments #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TupleSections #-} -{-# LANGUAGE TypeApplications #-} {-# OPTIONS_GHC -Wno-name-shadowing #-} -{-# OPTIONS_GHC -Wno-unused-local-binds #-} -- | Examples of conversion from dot ByteStrings -- -- Most examples from https://renenyffenegger.ch/notes/tools/Graphviz/examples/index module DotParse.Examples where -import qualified Algebra.Graph as G -import Control.Monad ( zipWithM_ ) -import Data.ByteString ( ByteString ) -import Data.Proxy ( Proxy(..) ) +import Algebra.Graph qualified as G +import Control.Monad (zipWithM_) +import Data.ByteString (ByteString) +import Data.Proxy (Proxy (..)) +import Data.String.Interpolate import DotParse import Prelude hiding (replicate) -import Data.String.Interpolate -- $setup -- >>> import DotParse @@ -45,8 +36,7 @@ -- >>> testDotParser (Proxy :: Proxy Graph) defaultDotConfig ex0 ex0 :: ByteString ex0 = - - [i| + [i| graph {} |] @@ -54,8 +44,7 @@ -- ![Example](other/ex1.svg) ex1 :: ByteString ex1 = - - [i| + [i| digraph D { A [shape=diamond] B [shape=box] @@ -70,8 +59,7 @@ -- ![Example](other/ex2.svg) ex2 :: ByteString ex2 = - - [i| + [i| digraph D { node [fontname="Arial"]; @@ -86,8 +74,7 @@ -- ![Example](other/ex3.svg) ex3 :: ByteString ex3 = - - [i| + [i| digraph D { A -> {B, C, D} -> {F} } @@ -98,8 +85,7 @@ -- ![Example](other/ex4.svg) ex4 :: ByteString ex4 = - - [i| + [i| digraph L { node [shape=record fontname=Arial]; @@ -118,8 +104,7 @@ -- ![Example](other/ex5.svg) ex5 :: ByteString ex5 = - - [i| + [i| digraph D { label = "The foo, the bar and the baz"; @@ -138,8 +123,7 @@ -- ![Example](other/ex6.svg) ex6 :: ByteString ex6 = - - [i| + [i| digraph D { label = foo,
the bar and
the baz>; @@ -157,8 +141,7 @@ -- ![Example](other/ex7.svg) ex7 :: ByteString ex7 = - - [i| + [i| digraph R { { rank=same rA sA tA } @@ -180,8 +163,7 @@ -- ![Example](other/ex8.svg) ex8 :: ByteString ex8 = - - [i| + [i| digraph Q { nd_1 [label = "Node 1"]; @@ -212,8 +194,7 @@ -- ![Example](other/ex9.svg) ex9 :: ByteString ex9 = - - [i| + [i| digraph D { subgraph cluster_p { @@ -248,8 +229,7 @@ -- ![Example](other/ex10.svg) ex10 :: ByteString ex10 = - - [i| + [i| digraph H { aHtmlTable [ @@ -271,8 +251,7 @@ -- ![Example](other/ex11.svg) ex11 :: ByteString ex11 = - - [i| + [i| digraph { tbl [ @@ -311,7 +290,7 @@ -- ![Example](other/ex12.svg) ex12 :: ByteString ex12 = - [i| + [i| digraph D { node [shape=plaintext] @@ -332,8 +311,7 @@ -- ![Example](other/ex13.svg) ex13 :: ByteString ex13 = - - [i| + [i| digraph H { aHtmlTable [ @@ -355,8 +333,7 @@ -- ![Example](other/ex14.svg) ex14 :: ByteString ex14 = - - [i| + [i| digraph H { parent [ @@ -404,8 +381,7 @@ -- ![Example](other/ex15.svg) ex15 :: ByteString ex15 = - - [i| + [i| digraph D { node [shape=plaintext fontname="Sans serif" fontsize="8"]; @@ -543,10 +519,9 @@ -- >>> writeChartOptions "other/exga.svg" (graphToChartWith defaultChartConfig exGraphAugmented) -- -- ![augmentation example](other/exga.svg) --- exAGraph :: G.Graph Int exAGraph = G.edges $ [(v, (v + 1) `mod` 6) | v <- [0 .. 5]] - ++ [(v, v + k) | v <- [0 .. 5], k <- [6, 12]] - ++ [(2, 18), (2, 19), (15, 18), (15, 19), (18, 3), (19, 3)] + <> [(v, v + k) | v <- [0 .. 5], k <- [6, 12]] + <> [(2, 18), (2, 19), (15, 18), (15, 19), (18, 3), (19, 3)] diff --git a/src/DotParse/Examples/NumHask.hs b/src/DotParse/Examples/NumHask.hs --- a/src/DotParse/Examples/NumHask.hs +++ b/src/DotParse/Examples/NumHask.hs @@ -1,34 +1,28 @@ -{-# LANGUAGE AllowAmbiguousTypes #-} -{-# LANGUAGE BlockArguments #-} -{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} -{-# HLINT ignore "Use ?~" #-} - --- | Example of Dot graph construction for the NumHask class heirarchy. +-- | Example of Dot graph construction for the class heirarchy. module DotParse.Examples.NumHask where -import qualified Algebra.Graph as G +import Algebra.Graph qualified as G import Chart import Data.Bifunctor -import qualified Data.Map.Strict as Map +import Data.Map.Strict qualified as Map import Data.Monoid +import Data.String.Interpolate import Data.Text (Text, pack) import DotParse +import FlatParse.Basic import GHC.IO.Unsafe import Optics.Core import Prelude hiding (replicate) -import Data.String.Interpolate -import FlatParse.Basic -- $setup -- >>> import DotParse -- >>> :set -XOverloadedStrings +-- | Names of the various classes used in numhask data Class = Magma | Unital @@ -58,7 +52,7 @@ | SubtractiveAction | MultiplicativeAction | DivisiveAction - | Module + | Actions | -- Lattice JoinSemiLattice | MeetSemiLattice @@ -70,97 +64,88 @@ Integral | Ratio | -- Measure - Signed - | Norm - | Basis + Basis | Direction | Epsilon deriving (Show, Eq, Ord) -data Family - = Addition - | Multiplication - | Actor - deriving (Show, Eq, Ord) - +-- | A class dependency. data Dependency = Dependency { _class :: Class, - _dep :: Class, - _op :: Maybe Family + _dep :: Class } deriving (Show, Eq, Ord) +-- | List of all dependencies (as at v0.11) dependencies :: [Dependency] dependencies = - [ Dependency Unital Magma Nothing, - Dependency Associative Magma Nothing, - Dependency Commutative Magma Nothing, - Dependency Invertible Magma Nothing, - Dependency Idempotent Magma Nothing, - Dependency Absorbing Magma Nothing, - Dependency Group Unital Nothing, - Dependency Group Invertible Nothing, - Dependency Group Associative Nothing, - Dependency AbelianGroup Unital Nothing, - Dependency AbelianGroup Invertible Nothing, - Dependency AbelianGroup Associative Nothing, - Dependency AbelianGroup Commutative Nothing, - Dependency Additive Commutative (Just Addition), - Dependency Additive Unital (Just Addition), - Dependency Additive Associative (Just Addition), - Dependency Subtractive Invertible (Just Addition), - Dependency Subtractive Additive (Just Addition), - Dependency Multiplicative Unital (Just Multiplication), - Dependency Multiplicative Associative (Just Multiplication), - Dependency Multiplicative Commutative (Just Multiplication), - Dependency Divisive Invertible (Just Multiplication), - Dependency Divisive Multiplicative (Just Multiplication), - Dependency Distributive Additive (Just Addition), - Dependency Distributive Multiplicative (Just Multiplication), - Dependency Distributive Absorbing Nothing, - Dependency Ring Distributive Nothing, - Dependency Ring Subtractive (Just Addition), - Dependency IntegralDomain Ring Nothing, - Dependency Field Ring Nothing, - Dependency Field Divisive (Just Multiplication), - Dependency ExpField Field Nothing, - Dependency QuotientField Field Nothing, - Dependency QuotientField Ring Nothing, - Dependency TrigField Field Nothing, - Dependency UpperBoundedField Field Nothing, - Dependency LowerBoundedField Field Nothing, + [ Dependency Unital Magma, + Dependency Associative Magma, + Dependency Commutative Magma, + Dependency Invertible Magma, + Dependency Idempotent Magma, + Dependency Absorbing Magma, + Dependency Group Unital, + Dependency Group Invertible, + Dependency Group Associative, + Dependency AbelianGroup Unital, + Dependency AbelianGroup Invertible, + Dependency AbelianGroup Associative, + Dependency AbelianGroup Commutative, + Dependency Additive Commutative, + Dependency Additive Unital, + Dependency Additive Associative, + Dependency Subtractive Invertible, + Dependency Subtractive Additive, + Dependency Multiplicative Unital, + Dependency Multiplicative Associative, + Dependency Multiplicative Commutative, + Dependency Divisive Invertible, + Dependency Divisive Multiplicative, + Dependency Distributive Additive, + Dependency Distributive Multiplicative, + Dependency Distributive Absorbing, + Dependency Ring Distributive, + Dependency Ring Subtractive, + Dependency IntegralDomain Ring, + Dependency Field Ring, + Dependency Field Divisive, + Dependency ExpField Field, + Dependency QuotientField Field, + Dependency QuotientField Ring, + Dependency TrigField Field, + Dependency UpperBoundedField Field, + Dependency LowerBoundedField Field, -- higher-kinded relationships - Dependency AdditiveAction Additive (Just Actor), - Dependency SubtractiveAction Subtractive (Just Actor), - Dependency MultiplicativeAction Multiplicative (Just Actor), - Dependency DivisiveAction Divisive (Just Actor), - Dependency Module Distributive (Just Actor), - Dependency Module MultiplicativeAction Nothing, + Dependency AdditiveAction Additive, + Dependency SubtractiveAction Subtractive, + Dependency MultiplicativeAction Multiplicative, + Dependency DivisiveAction Divisive, + Dependency Actions Distributive, -- Lattice - Dependency JoinSemiLattice Associative Nothing, - Dependency JoinSemiLattice Commutative Nothing, - Dependency JoinSemiLattice Idempotent Nothing, - Dependency MeetSemiLattice Associative Nothing, - Dependency MeetSemiLattice Commutative Nothing, - Dependency MeetSemiLattice Idempotent Nothing, - Dependency Lattice JoinSemiLattice Nothing, - Dependency Lattice MeetSemiLattice Nothing, - Dependency BoundedJoinSemiLattice JoinSemiLattice Nothing, - Dependency BoundedJoinSemiLattice Unital Nothing, - Dependency BoundedMeetSemiLattice MeetSemiLattice Nothing, - Dependency BoundedMeetSemiLattice Unital Nothing, - Dependency BoundedLattice BoundedJoinSemiLattice Nothing, - Dependency BoundedLattice BoundedMeetSemiLattice Nothing, - Dependency Signed Ring Nothing, - Dependency Norm Ring Nothing, - Dependency Basis Ring Nothing, - Dependency Direction Ring Nothing, - Dependency Epsilon Subtractive Nothing, - Dependency Epsilon MeetSemiLattice Nothing, - Dependency Integral Ring Nothing, - Dependency Ratio Field Nothing + Dependency JoinSemiLattice Associative, + Dependency JoinSemiLattice Commutative, + Dependency JoinSemiLattice Idempotent, + Dependency MeetSemiLattice Associative, + Dependency MeetSemiLattice Commutative, + Dependency MeetSemiLattice Idempotent, + Dependency Lattice JoinSemiLattice, + Dependency Lattice MeetSemiLattice, + Dependency BoundedJoinSemiLattice JoinSemiLattice, + Dependency BoundedJoinSemiLattice Unital, + Dependency BoundedMeetSemiLattice MeetSemiLattice, + Dependency BoundedMeetSemiLattice Unital, + Dependency BoundedLattice BoundedJoinSemiLattice, + Dependency BoundedLattice BoundedMeetSemiLattice, + Dependency Basis Distributive, + Dependency Direction Distributive, + Dependency Epsilon Subtractive, + Dependency Epsilon MeetSemiLattice, + Dependency Integral Ring, + Dependency Ratio Field ] +-- | List of classes to use in diagram. classesNH :: [Class] classesNH = [ Additive, @@ -173,17 +158,14 @@ ExpField, QuotientField, TrigField, - Signed, - Norm, + Basis, Direction, - MultiplicativeAction, - Module, - UpperBoundedField, - LowerBoundedField, + Actions, Integral, Ratio ] +-- | Names of the modules where each class is located. classesModule :: [(Class, Text)] classesModule = [ (Additive, "NumHask-Algebra-Additive"), @@ -196,24 +178,23 @@ (ExpField, "NumHask-Algebra-Field"), (QuotientField, "NumHask-Algebra-Field"), (TrigField, "NumHask-Algebra-Field"), - (Signed, "NumHask-Algebra-Metric"), - (Norm, "NumHask-Algebra-Metric"), + (Basis, "NumHask-Algebra-Metric"), (Direction, "NumHask-Algebra-Metric"), - (MultiplicativeAction, "NumHask-Algebra-Module"), - (Module, "NumHask-Algebra-Module"), + (Actions, "NumHask-Algebra-Action"), (UpperBoundedField, "NumHask-Algebra-Field"), (LowerBoundedField, "NumHask-Algebra-Field"), (Integral, "NumHask-Data-Integral"), (Ratio, "NumHask-Data-Rational") ] +-- | List of dependencies to draw. dependenciesNH :: [Dependency] -> [Dependency] -dependenciesNH = filter (\(Dependency x0 x1 _) -> x0 `elem` classesNH && x1 `elem` classesNH) +dependenciesNH = filter (\(Dependency x0 x1) -> x0 `elem` classesNH && x1 `elem` classesNH) -- | NumHask Classes as an algebraic graph graphNHG :: G.Graph Class graphNHG = - G.edges ((\(Dependency x y _) -> (x, y)) <$> dependenciesNH dependencies) + G.edges ((\(Dependency x y) -> (x, y)) <$> dependenciesNH dependencies) <> G.vertices classesNH -- | NumHask statements in a dot Graph with box shapes for the nodes. @@ -233,7 +214,7 @@ -- | Convert a node ID to a label for chart-svg charts -- Doing this directly in dot doesn't quite work because the engines get the width of the link wrong. toLink :: ID -> Text -toLink id_ =[i|#{t}|] +toLink id_ = [i|#{t}|] where t = pack (label id_) m = Map.fromList (first (pack . show) <$> classesModule) Map.! t @@ -244,4 +225,4 @@ -- -- ![NumHask Example](other/nh.svg) writeNHChart :: IO () -writeNHChart = writeChartOptions "other/nh.svg" (graphToChartWith (defaultChartConfig & #labelf .~ toLink) (dotGraphNH' Directed)) +writeNHChart = writeChartOptions "other/nh.svg" (graphToChartWith (defaultChartConfig & #labelf .~ toLink & #chartColor .~ over lightness' (* 0.5) (palette1 2) & #chartBackgroundColor .~ set opac' 0.1 (palette1 1)) (dotGraphNH' Directed)) diff --git a/src/DotParse/FlatParse.hs b/src/DotParse/FlatParse.hs --- a/src/DotParse/FlatParse.hs +++ b/src/DotParse/FlatParse.hs @@ -1,20 +1,10 @@ -{-# LANGUAGE AllowAmbiguousTypes #-} -{-# LANGUAGE BangPatterns #-} {-# LANGUAGE BlockArguments #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} -{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TupleSections #-} -{-# LANGUAGE TypeApplications #-} -{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} -{-# HLINT ignore "Use <$>" #-} - -- | Lower-level flatparse parsers module DotParse.FlatParse ( Error (..), @@ -52,7 +42,7 @@ import Data.Bool import Data.ByteString hiding (empty, head, length, map, zip, zipWith) -import qualified Data.ByteString.Char8 as B +import Data.ByteString.Char8 qualified as B import Data.Char hiding (isDigit) import Data.List.NonEmpty import DotParse.FlatParse.TH hiding (merge) diff --git a/src/DotParse/FlatParse/TH.hs b/src/DotParse/FlatParse/TH.hs --- a/src/DotParse/FlatParse/TH.hs +++ b/src/DotParse/FlatParse/TH.hs @@ -1,17 +1,15 @@ -{-# LANGUAGE BlockArguments #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -Wno-name-shadowing #-} -{-# OPTIONS_GHC -Wno-unused-local-binds #-} -- | TH stage restriction guff for flatparsing module DotParse.FlatParse.TH where import Data.ByteString hiding (head, length, reverse) -import qualified Data.ByteString.Char8 as B +import Data.ByteString.Char8 qualified as B import Data.Char hiding (isDigit) import Data.Functor import FlatParse.Basic @@ -152,7 +150,7 @@ (p, _) -> case (e, e') of (Precise {}, _) -> e (_, Precise {}) -> e' - (Imprecise _ es, Imprecise _ es') -> Imprecise p (es ++ es') + (Imprecise _ es, Imprecise _ es') -> Imprecise p (es <> es') {-# NOINLINE merge #-} -- merge is "cold" code, so we shouldn't inline it. -- | Pretty print an error. The `ByteString` input is the source file. The offending line from the diff --git a/src/DotParse/Types.hs b/src/DotParse/Types.hs --- a/src/DotParse/Types.hs +++ b/src/DotParse/Types.hs @@ -1,23 +1,9 @@ -{-# LANGUAGE AllowAmbiguousTypes #-} -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE BlockArguments #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE DerivingVia #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# HLINT ignore "Use unwords" #-} -{-# HLINT ignore "Use <$>" #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} -{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TupleSections #-} -{-# LANGUAGE TypeApplications #-} {-# OPTIONS_GHC -Wno-name-shadowing #-} -{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} {-# OPTIONS_HADDOCK not-home #-} -- | Abstract Grammar for the dot language. @@ -62,6 +48,7 @@ addStatement, addStatements, SubGraphStatement (..), + GlobalAttributeStatement (..), -- * Graph Extraction bbL, @@ -91,20 +78,21 @@ ) where -import qualified Algebra.Graph as G +import Algebra.Graph qualified as G import Chart import Control.Monad import Data.Bool import Data.ByteString hiding (any, empty, filter, head, length, map, zip, zipWith) -import qualified Data.ByteString.Char8 as B +import Data.ByteString.Char8 qualified as B import Data.List.NonEmpty hiding (filter, head, length, map, zip, zipWith, (!!)) import Data.Map.Merge.Strict -import qualified Data.Map.Strict as Map +import Data.Map.Strict qualified as Map import Data.Maybe import Data.Monoid import Data.Proxy +import Data.String.Interpolate import Data.Text (Text) -import qualified Data.Text as Text +import Data.Text qualified as Text import Data.These import DotParse.FlatParse import FlatParse.Basic hiding (cut) @@ -113,7 +101,6 @@ import System.Exit import System.Process.ByteString import Prelude hiding (replicate) -import Data.String.Interpolate -- $setup -- >>> import DotParse @@ -442,10 +429,12 @@ instance DotParse AttributeStatement where dotPrint cfg (AttributeStatement t as) = bool - (intercalate - " " - [dotPrint cfg t, dotPrint cfg as]) - mempty (mempty == as) + ( intercalate + " " + [dotPrint cfg t, dotPrint cfg as] + ) + mempty + (mempty == as) dotParse = AttributeStatement <$> dotParse <*> dotParse @@ -580,7 +569,7 @@ -- | default dot graph as a ByteString defaultBS :: ByteString defaultBS = - [i| + [i| digraph { node [shape=circle ,height=0.5]; @@ -839,7 +828,6 @@ defaultChartConfig = ChartConfig 500 72 0.5 (over lightness' (* 0.5) (palette1 0)) (set opac' 0.2 (palette1 0)) 0.5 0.5 (-3.7) 14 (Text.pack . label) -- | convert a 'Graph' processed via the graphviz commands to a 'ChartOptions' --- graphToChartWith :: ChartConfig -> Graph -> ChartOptions graphToChartWith cfg g = mempty