erd (empty) → 0.1.0.0

raw patch · 4 files changed

+205/−0 lines, 4 filesdep +basedep +bytestringdep +containerssetup-changed

Dependencies added: base, bytestring, containers, graphviz, parsec, text

Files

Setup.hs +2/−0
UNLICENSE +24/−0
erd.cabal +74/−0
src/Main.hs +105/−0

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ UNLICENSE view

@@ -0,0 +1,24 @@+This is free and unencumbered software released into the public domain.++Anyone is free to copy, modify, publish, use, compile, sell, or+distribute this software, either in source code form or as a compiled+binary, for any purpose, commercial or non-commercial, and by any+means.++In jurisdictions that recognize copyright laws, the author or authors+of this software dedicate any and all copyright interest in the+software to the public domain. We make this dedication for the benefit+of the public at large and to the detriment of our heirs and+successors. We intend this dedication to be an overt act of+relinquishment in perpetuity of all present and future rights to this+software under copyright law.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR+OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,+ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR+OTHER DEALINGS IN THE SOFTWARE.++For more information, please refer to <http://unlicense.org/>

+ erd.cabal view

@@ -0,0 +1,74 @@+-- Initial erd.cabal generated by cabal init.  For further documentation, +-- see http://haskell.org/cabal/users-guide/++name:                erd+version:             0.1.0.0+homepage:            https://github.com/BurntSushi/erd+license:             PublicDomain+license-file:        UNLICENSE+author:              Andrew Gallant+maintainer:          jamslam@gmail.com+category:            Database, Development+build-type:          Simple+cabal-version:       >=1.8+synopsis:+  An entity-relationship diagram generator from a plain text description.+description:         +  erd transforms a plain text description of a relational database schema to a +  graphical representation of that schema. It is intended that the graph make+  use of common conventions when depicting entity-relationship diagrams,+  including modeling the cardinality of relationships between entities.+  .+  A quick example that transforms an `er` file to a PDF:+  .+  > $ curl 'https://raw.github.com/BurntSushi/erd/master/examples/simple.er' > simple.er+  > $ cat simple.er+  > # Entities are declared in '[' ... ']'. All attributes after the entity header+  > # up until the end of the file (or the next entity declaration) correspond+  > # to this entity.+  > [Person]+  > *name+  > height+  > weight+  > +birth_location_id+  > +  > [Location]+  > *id+  > city+  > state+  > country+  > +  > # Each relationship must be between exactly two entities, which need not+  > # be distinct. Each entity in the relationship has exactly one of four+  > # possible cardinalities:+  > #+  > # Cardinality    Syntax+  > # 0 or 1         0+  > # exactly 1      1+  > # 0 or more      *+  > # 1 or more      ++  > Person *--1 Location+  > $ erd -i simple.er -o simple.pdf+  .+  The PDF should now contain a graph that looks like this:+  .+  <<http://burntsushi.net/stuff/erd-example-simple.png>>+  .+  See the <https://github.com/BurntSushi/erd#readme README.md> file for more +  examples and instructions on how to write ER files.++source-repository head+  type: git+  location: git://github.com/BurntSushi/erd.git++executable erd+  hs-source-dirs: src+  main-is: Main.hs+  ghc-options: -Wall -fno-warn-name-shadowing -fno-warn-unused-do-bind+  build-depends:+    base == 4.6.*+    , graphviz == 2999.16.*+    , text == 0.11.*+    , parsec == 3.1.*+    , containers == 0.5.*+    , bytestring == 0.10.*

+ src/Main.hs view

@@ -0,0 +1,105 @@+{-# LANGUAGE OverloadedStrings #-}+module Main (main) where++import Control.Monad (forM_)+import qualified Data.ByteString as SB+import Data.Maybe (fromMaybe)+import qualified Data.Text.Lazy as L+import System.Exit (exitFailure)+import System.IO (hClose, hPutStrLn, stderr)+import Text.Printf (printf)++import Data.GraphViz+import qualified Data.GraphViz.Attributes.Colors.X11 as C+import qualified Data.GraphViz.Attributes.Complete as A+import qualified Data.GraphViz.Attributes.HTML as H+import qualified Data.GraphViz.Types.Generalised as G+import Data.GraphViz.Types.Monadic++import Config+import ER+import Parse++main :: IO ()+main = do+  conf <- configIO+  er' <- uncurry loadER (cin conf)+  case er' of+    Left err -> do+      hPutStrLn stderr err+      exitFailure+    Right er -> let dotted = dotER er+                    toFile h = SB.hGetContents h >>= SB.hPut (snd $ cout conf)+                    fmt = fromMaybe Pdf (outfmt conf)+                 in graphvizWithHandle Dot dotted fmt toFile+  hClose (snd $ cin conf)+  hClose (snd $ cout conf)++-- | Converts an entire ER-diagram from an ER file into a GraphViz graph.+dotER :: ER -> G.DotGraph L.Text+dotER er = graph' $ do+  graphAttrs (graphTitle $ title er)+  graphAttrs [A.RankDir A.FromLeft]+  nodeAttrs [shape PlainText] -- recommended for HTML labels+  edgeAttrs [ A.Color [A.toWC $ A.toColor C.Gray50] -- easier to read labels+            , A.MinLen 2 -- give some breathing room+            , A.Style [A.SItem A.Dashed []] -- easier to read labels, maybe?+            ]+  forM_ (entities er) $ \e ->+    node (name e) [toLabel (htmlEntity e)]+  forM_ (rels er) $ \r -> do+    let opts = roptions r+    let rlab = A.HtmlLabel . H.Text . htmlFont opts . L.pack . show+    let (l1, l2) = (A.TailLabel $ rlab $ card1 r, A.HeadLabel $ rlab $ card2 r)+    let label = A.Label $ A.HtmlLabel $ H.Text $ withLabelFmt " %s " opts []+    edge (entity1 r) (entity2 r) [label, l1, l2]++-- | Converts a single entity to an HTML label.+htmlEntity :: Entity -> H.Label+htmlEntity e = H.Table H.HTable+                 { H.tableFontAttrs = Just $ optionsTo optToFont $ eoptions e+                 , H.tableAttrs = optionsTo optToHtml (eoptions e)+                 , H.tableRows = rows+                 }+  where rows = headerRow : map htmlAttr (attribs e)+        headerRow = H.Cells [H.LabelCell [] $ H.Text text]+        text = withLabelFmt " [%s]" (hoptions e) $ bold hname+        hname = htmlFont (hoptions e) (name e)+        bold s = [H.Format H.Bold s]++-- | Converts a single attribute to an HTML table row.+htmlAttr :: ER.Attribute -> H.Row+htmlAttr a = H.Cells [cell]+  where cell = H.LabelCell cellAttrs (H.Text $ withLabelFmt " [%s]" opts name)+        name = fkfmt $ pkfmt $ htmlFont opts (field a)+        pkfmt s = if pk a then [H.Format H.Underline s] else s+        fkfmt s = if fk a then [H.Format H.Italics s] else s+        cellAttrs = H.Align H.HLeft : optionsTo optToHtml opts+        opts = aoptions a++-- | Formats HTML text with a label. The format string given should be+-- in `Data.Text.printf` style. (Only font options are used from the options+-- given.)+withLabelFmt :: String -> Options -> H.Text -> H.Text+withLabelFmt fmt opts s =+  case optionsTo optToLabel opts of+    (x:_) -> s ++ htmlFont opts (L.pack $ printf fmt $ L.unpack x)+    _ -> s++-- | Formats an arbitrary string with the options given (using only font+-- attributes).+htmlFont :: Options -> L.Text -> H.Text+htmlFont opts s = [H.Font (optionsTo optToFont opts) [H.Str s]]++-- | Extracts and formats a graph title from the options given.+-- The options should be title options from an ER value.+-- If a title does not exist, an empty list is returned and `graphAttrs attrs`+-- should be a no-op.+graphTitle :: Options -> [A.Attribute]+graphTitle topts =+  let glabel = optionsTo optToLabel topts+  in if null glabel then [] else+       [ A.LabelJust A.JLeft+       , A.LabelLoc A.VTop+       , A.Label $ A.HtmlLabel $ H.Text $ htmlFont topts (head glabel)+       ]