diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,2 +1,2 @@ -import Distribution.Simple +import Distribution.Simple main = defaultMain diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -1,28 +1,29 @@ {-# LANGUAGE OverloadedStrings #-} -module Main (main) where +module Main + (main) +where -import Control.Applicative ((<|>)) -import Control.Monad (forM_, guard) -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 Control.Applicative ((<|>)) +import Control.Monad (forM_, guard) +import qualified Data.ByteString as SB +import Data.Maybe (fromJust, fromMaybe) +import qualified Data.Text.Lazy as L +import System.Exit (exitFailure) +import System.IO (hClose, hPutStrLn, stderr) -import Data.GraphViz +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 Data.GraphViz.Commands (isGraphvizInstalled) - -import qualified Erd.ER as ER +import qualified Data.GraphViz.Attributes.Complete as A +import qualified Data.GraphViz.Attributes.HTML as H +import Data.GraphViz.Commands (isGraphvizInstalled) +import qualified Data.GraphViz.Types.Generalised as G +import Data.GraphViz.Types.Monadic -import Erd.Config -import Erd.ER -import Erd.Parse +import Erd.Config +import Erd.ER +import Erd.Parse +import Erd.Render (htmlAttr, htmlFont, + recordAttr, withLabelFmt) main :: IO () main = do @@ -33,10 +34,10 @@ Left err -> do hPutStrLn stderr err exitFailure - Right er -> let dotted = dotER conf er + Right er -> let erDot = dotER conf er toFile h = SB.hGetContents h >>= SB.hPut (snd $ cout conf) fmt = fromMaybe Pdf (outfmt conf) - in graphvizWithHandle Dot dotted fmt toFile + in graphvizWithHandle Dot erDot fmt toFile hClose (snd $ cin conf) hClose (snd $ cout conf) @@ -45,21 +46,27 @@ dotER conf er = graph' $ do graphAttrs (graphTitle $ title er) graphAttrs [ A.RankDir A.FromLeft - , A.Splines (edgeType conf) + , A.Splines $ fromMaybe (fromJust . edgeType $ defaultConfig) (edgeType conf) ] - nodeAttrs [shape PlainText] -- recommended for HTML labels + nodeAttrs nodeGlobalAttributes 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)] + node (name e) [entityFmt 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 [] + let optss = roptions r + rlab = A.HtmlLabel . H.Text . htmlFont optss . L.pack . show + (l1, l2) = (A.TailLabel $ rlab $ card1 r, A.HeadLabel $ rlab $ card2 r) + label = A.Label $ A.HtmlLabel $ H.Text $ withLabelFmt " %s " optss [] edge (entity1 r) (entity2 r) [label, l1, l2] + where nodeGlobalAttributes + | dotentity conf = [shape Record, A.RankDir A.FromTop] + | otherwise = [shape PlainText] -- recommended for HTML labels + entityFmt + | dotentity conf = toLabel . dotEntity + | otherwise = toLabel . htmlEntity -- | Converts a single entity to an HTML label. htmlEntity :: Entity -> H.Label @@ -70,33 +77,13 @@ } where rows = headerRow : map htmlAttr (attribs e) headerRow = H.Cells [H.LabelCell [] $ H.Text text] - text = withLabelFmt " [%s]" (hoptions e) $ bold hname + text = withLabelFmt " [%s]" (hoptions e) $ boldFont 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 + boldFont s = [H.Format H.Bold 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]] +-- | Converts a single entity to a plain Dot Label +dotEntity :: Entity -> A.RecordFields +dotEntity e = A.FieldLabel ( name e ) : map recordAttr (attribs e) -- | Extracts and formats a graph title from the options given. -- The options should be title options from an ER value. diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,4 +1,20 @@ -0.2.0.0 +0.2.1.0 (2020-02-01) + +* Add -v command-line flag to show verions and git revision. + +* Support of regular dot-tables to visualize entities. (PR #74) + +* Text alignment in a Cell of a Table is explicitly defined. (PR #64) + +* New build target using _static-haskell-nix_ to create statically linked erd. (PR #61) + +* Updating code to be compliant with ghc-8.6. + +* Resolving compiler warnings that were muted by erlier setup. + +* Adding optional '-c/--config' switch to use _~/.erd.yaml_ as configuration file (PR #68) + +0.2.0.0 (2019-03-26) * Adding test suite. (PR #46) diff --git a/erd.cabal b/erd.cabal --- a/erd.cabal +++ b/erd.cabal @@ -2,7 +2,7 @@ -- see http://haskell.org/cabal/users-guide/ name: erd -version: 0.2.0.0 +version: 0.2.1.0 homepage: https://github.com/BurntSushi/erd license: PublicDomain license-file: UNLICENSE @@ -10,7 +10,10 @@ maintainer: jamslam@gmail.com category: Database, Development build-type: Simple -cabal-version: >=1.8 +cabal-version: >=1.10 + +Tested-With: GHC ==8.6.4 || ==8.4.4 + synopsis: An entity-relationship diagram generator from a plain text description. description: @@ -19,13 +22,15 @@ 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: + + A quick example that transforms an `er` file to a PDF is just below. The + original source file can be found amongst the examples in the repository. . - > $ curl 'https://raw.githubusercontent.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. + > # 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 @@ -38,9 +43,9 @@ > 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: + > # 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 @@ -65,43 +70,53 @@ location: git://github.com/BurntSushi/erd.git executable erd + default-language: Haskell2010 hs-source-dirs: app, src - other-modules: - Erd.Config - Erd.ER - Erd.Parse - Text.Parsec.Erd.Parser + other-modules: Erd.Config + , Erd.ER + , Erd.Parse + , Erd.Render + , Paths_erd + , Text.Parsec.Erd.Parser main-is: Main.hs - ghc-options: -Wall -fno-warn-name-shadowing -fno-warn-unused-do-bind - build-depends: - base >=4.5 && <5 - , graphviz == 2999.* - , text == 1.* - , parsec == 3.1.* - , containers == 0.5.* - , bytestring == 0.10.* + ghc-options: -Wall -W + build-depends: base >= 4.5 && <5 + , directory >= 1.3.1.5 + , filepath >= 1.4.2 + , gitrev >= 1.3.1 + , graphviz == 2999.20.* + , text == 1.* + , parsec == 3.1.* + , containers >= 0.5.11.0 + , bytestring == 0.10.* + , yaml >= 0.8.32 + , raw-strings-qq >= 1.1 test-suite spec + default-language: Haskell2010 type: exitcode-stdio-1.0 main-is: Spec.hs - ghc-options: -Wall -fno-warn-name-shadowing -fno-warn-unused-do-bind + ghc-options: -Wall -W hs-source-dirs: test, src - other-modules: - Erd.Config - Erd.ER - Erd.Parse - Text.Parsec.Erd.Parser - Test.Text.Parsec.Erd.Parser - build-depends: - QuickCheck - , hspec - , base >=4.5 && <5 - , graphviz == 2999.* - , text == 1.* - , parsec == 3.1.* - , containers == 0.5.* - , bytestring == 0.10.* - , tasty >= 0.11 - , tasty-hunit >= 0.9 - , raw-strings-qq >= 1.1 + other-modules: Erd.Config + , Erd.ER + , Erd.Parse + , Erd.Render + , Text.Parsec.Erd.Parser + , Test.Erd.Render + , Test.Text.Parsec.Erd.Parser + , Paths_erd + build-depends: base >=4.5 && <5 + , directory >= 1.3.1.5 + , filepath >= 1.4.2 + , gitrev >= 1.3.1 + , graphviz == 2999.* + , text == 1.* + , parsec == 3.1.* + , containers >= 0.5.11.0 + , bytestring == 0.10.* + , tasty >= 0.11 + , tasty-hunit >= 0.9 + , yaml >= 0.8.32 + , raw-strings-qq >= 1.1 diff --git a/src/Erd/Config.hs b/src/Erd/Config.hs --- a/src/Erd/Config.hs +++ b/src/Erd/Config.hs @@ -1,38 +1,88 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TemplateHaskell #-} + module Erd.Config ( Config(..) , configIO + , defaultConfig + , defaultConfigFile ) where -import Data.Char (isSpace) -import Data.List (dropWhileEnd, intercalate) -import qualified Data.Map as M -import Data.Maybe (isNothing) -import qualified System.Console.GetOpt as O -import System.Environment (getArgs) -import System.Exit (exitFailure) -import System.IO (Handle, IOMode(..), stdin, stdout, stderr, openFile) -import Text.Printf (HPrintfType, hPrintf, printf) - -import qualified Data.GraphViz.Commands as G +import Control.Exception (tryJust) +import Control.Monad (guard) +import qualified Data.ByteString.Char8 as B +import Data.Char (isSpace) import qualified Data.GraphViz.Attributes.Complete as A +import qualified Data.GraphViz.Commands as G +import Data.List (dropWhileEnd, intercalate) +import qualified Data.Map as M +import Data.Maybe (isNothing) +import Data.Version (showVersion) +import Data.Yaml (FromJSON (..), (.:)) +import qualified Data.Yaml as Y +import Development.GitRev (gitHash) +import Paths_erd (version) +import qualified System.Console.GetOpt as O +import System.Directory (getHomeDirectory) +import System.Environment (getArgs) +import System.Exit (exitFailure, exitSuccess) +import System.FilePath (()) +import System.IO (Handle, IOMode (..), + openFile, stderr, stdin, + stdout) +import System.IO.Error (isDoesNotExistError) +import Text.Printf (HPrintfType, hPrintf, + printf) +import Text.RawString.QQ -- | Config represents all information from command line flags. -data Config = - Config { cin :: (String, Handle) - , cout :: (String, Handle) - , outfmt :: Maybe G.GraphvizOutput - , edgeType :: A.EdgeType - } +data Config = Config + { cin :: (String, Handle) + , cout :: (String, Handle) + , outfmt :: Maybe G.GraphvizOutput + , edgeType :: Maybe A.EdgeType + , configFile :: Maybe FilePath + , dotentity :: Bool + } +-- | Represents fields that are stored in the configuration file. +data ConfigFile = ConfigFile + { cFmtOut :: String + , cEdgeType :: String + , cDotEntity :: Bool + } + deriving Show + +instance FromJSON ConfigFile where + parseJSON (Y.Object v) = + ConfigFile <$> + v .: "output-format" <*> + v .: "edge-style" <*> + v .: "dot-entity" + parseJSON _ = fail "Incorrect configuration file." + defaultConfig :: Config defaultConfig = Config { cin = ("", stdin) , cout = ("", stdout) , outfmt = Nothing - , edgeType = A.SplineEdges + , edgeType = Just A.SplineEdges + , configFile = Nothing + , dotentity = False } +defaultConfigFile :: B.ByteString +defaultConfigFile = B.unlines + [[r|# Erd (~/.erd.yaml) default configuration file.|], + B.append [r|output-format: pdf # Supported formats: |] (defVals fmts), + B.append [r|edge-style: spline # Supported values : |] (defVals edges), + B.append [r|dot-entity: false # Supported values : |] (defVals valBool) + ] + where + defVals = B.pack . unwords . M.keys + -- | Creates a new Config value from command line options. -- If an output path is given and `--fmt` is omitted, then a format -- will be inferred from the output path extension. @@ -57,13 +107,31 @@ ef "erd does not have any positional arguments.\n\n" usageExit +-- | Order of processing command-line options is important to keep priority of +-- configuration sources, in terms of increasing precedence. +-- 1. Command-line options +-- 2. Configuration file of arbitrary path, e.g. '-c"/tmp/myconfig.yaml"' +-- 3. Configuration file: ~/.erd.yaml opts :: [O.OptDescr (IO Config -> IO Config)] opts = - [ O.Option "i" ["input"] + [ O.Option "c" ["config"] + (O.OptArg (\mf cIO -> cIO >>= \c -> do + globConfFile <- readGlobalConfigFile + f <- readConfigFile mf + case (f, globConfFile) of + (Nothing, Nothing) -> -- Config-file is desired, but unavailable. + B.putStr defaultConfigFile >> return c + (Nothing, Just x) -> -- Use global config-file from ~/.erd.yaml . + return $ toConfig x + (Just x, _) -> -- Use user specified config-file. + return $ toConfig x + ) "FILE") + "Configuration file." + , O.Option "i" ["input"] (O.ReqArg (\fpath cIO -> do c <- cIO i <- openFile fpath ReadMode - return $ c { cin = (fpath, i) } + return $ c {cin = (fpath, i)} ) "FILE") ("When set, input will be read from the given file.\n" @@ -72,7 +140,7 @@ (O.ReqArg (\fpath cIO -> do c <- cIO o <- openFile fpath WriteMode - return $ c { cout = (fpath, o) } + return $ c {cout = (fpath, o)} ) "FILE") ("When set, output will be written to the given file.\n" @@ -90,8 +158,7 @@ Nothing -> do ef "'%s' is not a valid output format." fmt exitFailure - Just gfmt -> - return $ c { outfmt = Just gfmt } + Just gfmt -> return c {outfmt = Just gfmt} ) "FMT") (printf "Force the output format to one of:\n%s" @@ -104,14 +171,44 @@ Nothing -> do ef "'%s' is not a valid type of edge." edge exitFailure - Just edgeType -> - return $ c { edgeType = edgeType } + Just x -> return c {edgeType = Just x} ) "EDGE") (printf "Select one type of edge:\n%s" (intercalate ", " $ M.keys edges)) + , O.Option "d" ["dot-entity"] + (O.NoArg (\cIO -> do + c <- cIO + return $ c { dotentity = True } )) + ("When set, output will consist of regular dot tables instead of HTML tables.\n" + ++ "Formatting will be disabled. Use only for further manual configuration.") + , O.Option "v" ["version"] + (O.NoArg $ const erdVersion) "Shows version of application and revision code.." ] +toConfig :: ConfigFile -> Config +toConfig c = defaultConfig {outfmt = toGraphFmt $ cFmtOut c, + edgeType = toEdgeG $ cEdgeType c, + dotentity = cDotEntity c } + +-- | Reads and parses configuration file at default location: ~/.erd.yaml +readGlobalConfigFile :: IO (Maybe ConfigFile) +readGlobalConfigFile = do + mHome <- tryJust (guard . isDoesNotExistError) getHomeDirectory + case mHome of + Left _ -> return Nothing + Right home -> readConfigFile $ Just (home ".erd.yaml") + +-- | Reads and parses a configuration file, exceptions may come via +-- AesonException. +readConfigFile :: Maybe FilePath -> IO (Maybe ConfigFile) +readConfigFile Nothing = return Nothing +readConfigFile (Just f) = do + mHome <- tryJust (guard . isDoesNotExistError) $ B.readFile f + case mHome of + Left _ -> return Nothing + Right home -> Y.decodeThrow home + -- | A subset of formats supported from GraphViz. fmts :: M.Map String (Maybe G.GraphvizOutput) fmts = M.fromList @@ -138,6 +235,11 @@ , ("compound", Just A.CompoundEdge) ] +valBool :: M.Map String Bool +valBool = M.fromList + [ ("true", True) + , ("false", False) ] + -- | takeExtension returns the last extension from a file path, or the -- empty string if no extension was found. e.g., the extension of -- "wat.pdf" is "pdf". @@ -155,7 +257,12 @@ usageExit = usage >> exitFailure usage :: IO () -usage = ef "%s\n" $ O.usageInfo "Usage: erd [flags]" opts +usage = hPrintf stderr "%s\n" $ O.usageInfo "Usage: erd [flags]" opts + +erdVersion :: IO a +erdVersion = do + hPrintf stdout "erd-%s %s\n" (showVersion version) ($(gitHash) :: String) + exitSuccess ef :: HPrintfType r => String -> r ef = hPrintf stderr diff --git a/src/Erd/ER.hs b/src/Erd/ER.hs --- a/src/Erd/ER.hs +++ b/src/Erd/ER.hs @@ -6,45 +6,48 @@ , Options, mergeOpts, optionsTo , Option(..), optionByName, optToFont, optToHtml, optToLabel , Relation(..) , Cardinality(..), cardByName - , defaultTitleOpts, defaultEntityOpts, defaultHeaderOpts, defaultRelOpts + , defaultAttrOpts, defaultTitleOpts, defaultEntityOpts, defaultHeaderOpts, defaultRelOpts ) where -import qualified Data.Map as M -import Data.Maybe (mapMaybe) -import Data.Text.Lazy -import Data.Word (Word8) -import Text.Printf (printf) +import qualified Data.Map as M +import Data.Maybe (mapMaybe) +import Data.Text.Lazy +import Data.Word (Word8) +import Text.Printf (printf) -import Data.GraphViz.Parsing (ParseDot, parse, runParser) -import qualified Data.GraphViz.Attributes.HTML as H -import Data.GraphViz.Attributes.Colors (Color) +import Data.GraphViz.Attributes.Colors (Color) +import qualified Data.GraphViz.Attributes.HTML as H +import Data.GraphViz.Parsing (ParseDot, parse, runParser) -- | Represents a single schema. -data ER = ER { entities :: [Entity] - , rels :: [Relation] - , title :: Options - } - deriving (Show, Eq) +data ER = ER + { entities :: [Entity] + , rels :: [Relation] + , title :: Options + } + deriving (Show, Eq) -- | Represents a single entity in a schema. -data Entity = Entity { name :: Text - , attribs :: [Attribute] - , hoptions :: Options - , eoptions :: Options - } - deriving (Show, Eq) +data Entity = Entity + { name :: Text + , attribs :: [Attribute] + , hoptions :: Options + , eoptions :: Options + } + deriving (Show, Eq) instance Ord Entity where e1 `compare` e2 = name e1 `compare` name e2 -- | Represents a single attribute in a particular entity. -data Attribute = Attribute { field :: Text - , pk :: Bool - , fk :: Bool - , aoptions :: Options - } - deriving (Show, Eq) +data Attribute = Attribute + { field :: Text + , pk :: Bool + , fk :: Bool + , aoptions :: Options + } + deriving (Show, Eq) instance Ord Attribute where a1 `compare` a2 = field a1 `compare` field a2 @@ -70,16 +73,17 @@ -- | A restricted subset of options in GraphViz that can be configured in -- an ER file. data Option = Label String - | BgColor Color - | Color Color - | FontFace Text - | FontSize Double - | Border Word8 - | BorderColor Color - | CellSpacing Word8 - | CellBorder Word8 - | CellPadding Word8 - deriving (Show, Eq) + | BgColor Color + | Color Color + | FontFace Text + | FontSize Double + | Border Word8 + | BorderColor Color + | CellSpacing Word8 + | CellBorder Word8 + | CellPadding Word8 + | TextAlignment H.Align + deriving (Show, Eq) -- | Given an option name and a string representation of its value, -- `optionByName` will attempt to parse the string as a value corresponding @@ -96,6 +100,7 @@ optionByName "cellspacing" = optionParse CellSpacing optionByName "cellborder" = optionParse CellBorder optionByName "cellpadding" = optionParse CellPadding +optionByName "text-alignment" = optionParse TextAlignment optionByName unk = const (Left $ printf "Option '%s' does not exist." unk) -- | A wrapper around the GraphViz's parser for any particular option. @@ -103,31 +108,33 @@ optionParse con s = case fst $ runParser parse quoted of Left err -> Left (printf "%s (bad value '%s')" err s) - Right a -> Right (con a) + Right a -> Right (con a) where quoted = "\"" `append` pack s `append` "\"" -- | Selects an option if and only if it corresponds to a font attribute. optToFont :: Option -> Maybe H.Attribute -optToFont (Color c) = Just $ H.Color c +optToFont (Color c) = Just $ H.Color c optToFont (FontFace s) = Just $ H.Face s optToFont (FontSize d) = Just $ H.PointSize d -optToFont _ = Nothing +optToFont _ = Nothing -- | Selects an option if and only if it corresponds to an HTML attribute. -- In particular, for tables or table cells. optToHtml :: Option -> Maybe H.Attribute -optToHtml (BgColor c) = Just $ H.BGColor c -optToHtml (Border w) = Just $ H.Border w -optToHtml (BorderColor c) = Just $ H.Color c -optToHtml (CellSpacing w) = Just $ H.CellSpacing w -optToHtml (CellBorder w) = Just $ H.CellBorder w -optToHtml (CellPadding w) = Just $ H.CellPadding w -optToHtml _ = Nothing +optToHtml (BgColor c) = pure $ H.BGColor c +optToHtml (Border w) = pure $ H.Border w +optToHtml (BorderColor c) = pure $ H.Color c +optToHtml (CellSpacing w) = pure $ H.CellSpacing w +optToHtml (CellBorder w) = pure $ H.CellBorder w +optToHtml (CellPadding w) = pure $ H.CellPadding w +optToHtml (TextAlignment x) = pure $ H.Align x +optToHtml _ = Nothing + -- | Selects an option if and only if it corresponds to a label. optToLabel :: Option -> Maybe Text optToLabel (Label s) = Just $ pack s -optToLabel _ = Nothing +optToLabel _ = Nothing -- | Represents a relationship between exactly two entities. After parsing, -- each `rel` is guaranteed to correspond to an entity defined in the same @@ -135,22 +142,24 @@ -- -- Each relationship has one of four cardinalities specified for both entities. -- Those cardinalities are: 0 or 1, exactly 1, 0 or more and 1 or more. -data Relation = Relation { entity1, entity2 :: Text - , card1, card2 :: Cardinality - , roptions :: Options - } - deriving (Show, Eq) +data Relation = Relation + { entity1, entity2 :: Text + , card1, card2 :: Cardinality + , roptions :: Options + } + deriving (Show, Eq) data Cardinality = ZeroOne - | One - | ZeroPlus - | OnePlus deriving (Eq) + | One + | ZeroPlus + | OnePlus + deriving (Eq) instance Show Cardinality where - show ZeroOne = "{0,1}" - show One = "1" + show ZeroOne = "{0,1}" + show One = "1" show ZeroPlus = "0..N" - show OnePlus ="1..N" + show OnePlus = "1..N" -- | Maps a string representation to a particular relationship cardinality. cardByName :: Char -> Maybe Cardinality @@ -158,7 +167,7 @@ cardByName '1' = Just One cardByName '*' = Just ZeroPlus cardByName '+' = Just OnePlus -cardByName _ = Nothing +cardByName _ = Nothing -- | Hard-coded default options for all graph titles. defaultTitleOpts :: Options @@ -185,3 +194,8 @@ -- | Hard-coded default options for all relationships. defaultRelOpts :: Options defaultRelOpts = M.empty + +defaultAttrOpts :: Options +defaultAttrOpts = M.fromList + [ ("text-alignment", TextAlignment H.HLeft) + ] diff --git a/src/Erd/Parse.hs b/src/Erd/Parse.hs --- a/src/Erd/Parse.hs +++ b/src/Erd/Parse.hs @@ -4,25 +4,25 @@ ) where -import Control.Monad (when) -import Data.List (find) -import Data.Maybe -import Data.Text.Lazy hiding (find, map, reverse) -import Data.Text.Lazy.IO -import System.IO (Handle) -import Text.Parsec -import Text.Printf (printf) -import Text.Parsec.Erd.Parser (AST(..), GlobalOptions(..), document) +import Erd.ER -import Erd.ER +import Control.Monad (when) +import Data.List (find) +import Data.Maybe +import Data.Text.Lazy hiding (find, map, reverse) +import Data.Text.Lazy.IO +import System.IO (Handle) +import Text.Parsec +import Text.Parsec.Erd.Parser (AST (..), GlobalOptions (..), document) +import Text.Printf (printf) loadER :: String -> Handle -> IO (Either String ER) loadER fpath f = do s <- hGetContents f case parse (do { (opts, ast) <- document; return $ toER opts ast}) fpath s of - Left err -> return $ Left $ show err + Left err -> return $ Left $ show err Right err@(Left _) -> return err - Right (Right er) -> return $ Right er + Right (Right er) -> return $ Right er -- | Converts a list of syntactic categories in an entity-relationship -- description to an ER representation. If there was a problem with the @@ -32,18 +32,18 @@ -- This preserves the ordering of the syntactic elements in the original -- description. toER :: GlobalOptions -> [AST] -> Either String ER -toER gopts = toER' (ER [] [] title) - where title = gtoptions gopts `mergeOpts` defaultTitleOpts +toER gopts = toER' (ER [] [] erTitle) + where erTitle = gtoptions gopts `mergeOpts` defaultTitleOpts toER' :: ER -> [AST] -> Either String ER toER' er [] = Right (reversed er) >>= validRels - toER' (ER { entities = [] }) (A a:_) = - let name = show (field a) - in Left $ printf "Attribute '%s' comes before first entity." name - toER' er@(ER { entities = e':es }) (A a:xs) = do + toER' ER { entities = [] } (A a:_) = + let fieldName = show (field a) + in Left $ printf "Attribute '%s' comes before first entity." fieldName + toER' er@ER { entities = e':es } (A a:xs) = do let e = e' { attribs = a:attribs e' } toER' (er { entities = e:es }) xs - toER' er@(ER { entities = es }) (E e:xs) = do + toER' er@ER { entities = es } (E e:xs) = do let opts = eoptions e `mergeOpts` geoptions gopts `mergeOpts` defaultEntityOpts @@ -51,14 +51,14 @@ `mergeOpts` ghoptions gopts `mergeOpts` defaultHeaderOpts toER' (er { entities = e { eoptions = opts, hoptions = hopts }:es}) xs - toER' er@(ER { rels = rs }) (R r:xs) = do + toER' er@ER { rels = rs } (R r:xs) = do let opts = roptions r `mergeOpts` groptions gopts `mergeOpts` defaultRelOpts toER' (er { rels = r { roptions = opts }:rs }) xs reversed :: ER -> ER - reversed er@(ER { entities = es, rels = rs }) = + reversed er@ER { entities = es, rels = rs } = let es' = map (\e -> e { attribs = reverse (attribs e) }) es in er { entities = reverse es', rels = reverse rs } diff --git a/src/Erd/Render.hs b/src/Erd/Render.hs new file mode 100644 --- /dev/null +++ b/src/Erd/Render.hs @@ -0,0 +1,41 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Erd.Render + (htmlAttr, + htmlFont, + recordAttr, + withLabelFmt + ) where + +import qualified Erd.ER as ER + +import qualified Data.GraphViz.Attributes.Complete as A +import qualified Data.GraphViz.Attributes.HTML as H +import qualified Data.Text.Lazy as L +import Text.Printf (printf) + +-- | 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 (ER.field a) + pkfmt s = if ER.pk a then [H.Format H.Underline s] else s + fkfmt s = if ER.fk a then [H.Format H.Italics s] else s + opts = ER.aoptions a + cellAttrs = ER.optionsTo ER.optToHtml opts +-- | Converts a single attribute to a RecordField ( an element of a dot table ) +recordAttr :: ER.Attribute -> A.RecordField +recordAttr a = A.FieldLabel $ ER.field a -- should change to add port support! +-- | Formats an arbitrary string with the options given (using only font +-- attributes). +htmlFont :: ER.Options -> L.Text -> H.Text +htmlFont opts s = [H.Font (ER.optionsTo ER.optToFont opts) [H.Str s]] + +-- | 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 -> ER.Options -> H.Text -> H.Text +withLabelFmt fmt opts s = + case ER.optionsTo ER.optToLabel opts of + (x:_) -> s ++ htmlFont opts (L.pack $ printf fmt $ L.unpack x) + _ -> s diff --git a/src/Text/Parsec/Erd/Parser.hs b/src/Text/Parsec/Erd/Parser.hs --- a/src/Text/Parsec/Erd/Parser.hs +++ b/src/Text/Parsec/Erd/Parser.hs @@ -1,39 +1,39 @@ {-# LANGUAGE OverloadedStrings #-} + module Text.Parsec.Erd.Parser - ( - AST(..), + ( AST(..), GlobalOptions(..), document, globalOptions, entity, rel, attr, - comment, - ) -where + comment + ) where -import Control.Monad (liftM2, when, void) -import Data.Char (isAlphaNum, isSpace, isControl) -import qualified Data.Map as M -import Data.Maybe -import Data.Text.Lazy -import Text.Parsec -import Text.Parsec.Text.Lazy -import Text.Printf (printf) +import Erd.ER -import Erd.ER +import Control.Monad (liftM2, void, when) +import Data.Char (isAlphaNum, isControl, isSpace) +import qualified Data.Map as M +import Data.Maybe +import Data.Text.Lazy +import Text.Parsec +import Text.Parsec.Text.Lazy +import Text.Printf (printf) data AST = E Entity - | A Attribute - | R Relation - deriving (Show, Eq) + | A Attribute + | R Relation + deriving (Show, Eq) -data GlobalOptions = GlobalOptions { gtoptions :: Options - , ghoptions :: Options - , geoptions :: Options - , groptions :: Options - } - deriving (Show, Eq) +data GlobalOptions = GlobalOptions + { gtoptions :: Options + , ghoptions :: Options + , geoptions :: Options + , groptions :: Options + } + deriving (Show, Eq) emptyGlobalOptions :: GlobalOptions emptyGlobalOptions = GlobalOptions M.empty M.empty M.empty M.empty @@ -67,18 +67,17 @@ eolComment return $ Just - $ A Attribute { field = n, pk = ispk, fk = isfk, aoptions = opts } + $ A Attribute {field = n, pk = ispk, fk = isfk, aoptions = opts <> defaultAttrOpts} rel :: Parser (Maybe AST) rel = do let ops = "?1*+" e1 <- ident op1 <- oneOf ops - string "--" + _ <- string "--" op2 <- oneOf ops e2 <- ident opts <- options - let getCard op = case cardByName op of Just t -> return t @@ -86,12 +85,12 @@ t1 <- getCard op1 t2 <- getCard op2 return $ Just $ R Relation { entity1 = e1, entity2 = e2 - , card1 = t1, card2 = t2, roptions = opts } + , card1 = t1, card2 = t2, roptions = opts } globalOptions :: GlobalOptions -> Parser GlobalOptions globalOptions gopts = option gopts $ try $ do - n <- ident + n <- ident opts <- options case n of "title" -> emptiness >> globalOptions (gopts { gtoptions = opts}) @@ -110,19 +109,19 @@ opt :: Parser (String, Option) opt = do - name <- liftM2 (:) letter (manyTill (letter <|> char '-') (char ':')) + optName <- liftM2 (:) letter (manyTill (letter <|> char '-') (char ':')) "option name" emptiness value <- between (char '"') (char '"') (many $ noneOf "\"") "option value" - case optionByName name value of + case optionByName optName value of Left err -> fail err - Right o' -> emptiness >> return (name, o') + Right o' -> emptiness >> return (optName, o') comment :: Parser (Maybe AST) comment = do - char '#' - manyTill anyChar $ try eol + _ <- char '#' + _ <- manyTill anyChar $ try eol return Nothing ident :: Parser Text @@ -138,7 +137,7 @@ let p = satisfy (\c -> c /= quote && not (isControl c) ) "any character except " ++ [quote] ++ " or control characters" n <- fmap pack (many1 p) - char quote + _ <- char quote return n identNoSpace :: Parser Text diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,9 +1,14 @@ -module Main (main) where -import Test.Tasty -import Test.Text.Parsec.Erd.Parser (testEr) +module Main + (main) +where +import Test.Erd.Render (testRender) +import Test.Tasty +import Test.Text.Parsec.Erd.Parser (testEr) + main :: IO () -main = defaultMain $ testGroup "Erd Tests" tests +main = defaultMain $ testGroup "Erd Tests" tests tests :: [TestTree] -tests = [testEr] +tests = [testEr, + testRender] diff --git a/test/Test/Erd/Render.hs b/test/Test/Erd/Render.hs new file mode 100644 --- /dev/null +++ b/test/Test/Erd/Render.hs @@ -0,0 +1,25 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Test.Erd.Render + (testRender) +where + +import qualified Erd.ER as ER +import Erd.Render (htmlAttr) + +import qualified Data.GraphViz.Attributes.HTML as H +import Test.Tasty +import Test.Tasty.HUnit + +testRender :: TestTree +testRender = testGroup "Test of main-module" [ + testCase "Transform Erd field-attribute to HTML of GraphViz." test01 + ] +test01 :: Assertion +test01 = result @?= expected + where + inputF = "Field" + input = ER.Attribute inputF True False ER.defaultAttrOpts + result = htmlAttr input + expected = H.Cells [H.LabelCell [H.Align H.HLeft] + (H.Text [H.Format H.Underline [H.Font [] [H.Str inputF]]])] diff --git a/test/Test/Text/Parsec/Erd/Parser.hs b/test/Test/Text/Parsec/Erd/Parser.hs --- a/test/Test/Text/Parsec/Erd/Parser.hs +++ b/test/Test/Text/Parsec/Erd/Parser.hs @@ -1,20 +1,24 @@ {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE QuasiQuotes #-} + module Test.Text.Parsec.Erd.Parser - (testEr) - where -import Test.Tasty -import Test.Tasty.HUnit -import Text.RawString.QQ (r) -import Data.Text (Text) -import Data.Text.Lazy (fromStrict) -import Text.Parsec (parse) -import qualified Data.Map as M -import Data.Map (fromList) -import Erd.ER -import Text.Parsec.Erd.Parser (document, AST(..), GlobalOptions(..)) -import Data.GraphViz.Attributes.Colors (Color(..)) + (testEr + ) where +import Data.GraphViz.Attributes.Colors (Color (..)) +import qualified Data.GraphViz.Attributes.HTML as H +import Data.Map (fromList) +import qualified Data.Map as M +import Data.Text (Text) +import Data.Text.Lazy (fromStrict) +import Erd.ER +import Test.Tasty +import Test.Tasty.HUnit +import Text.Parsec (parse) +import Text.Parsec.Erd.Parser (AST (..), GlobalOptions (..), + document) +import Text.RawString.QQ (r) + parseDoc :: Text -> (GlobalOptions, [AST]) -> Assertion parseDoc input expect= Right expect `shouldBe` parse document "" (fromStrict input) where shouldBe = assertEqual "" @@ -61,16 +65,16 @@ opts = GlobalOptions M.empty M.empty M.empty M.empty asts = [ E (Entity {name = "Person", attribs = [], hoptions = fromList [], eoptions = fromList []}), - A (Attribute {field = "name", pk = True, fk = False, aoptions = fromList []}), - A (Attribute {field = "height", pk = False, fk = False, aoptions = fromList []}), - A (Attribute {field = "weight", pk = False, fk = False, aoptions = fromList []}), - A (Attribute {field = "birth date", pk = False, fk = False, aoptions = fromList []}), - A (Attribute {field = "birth_place_id", pk = False, fk = True, aoptions = fromList []}), + A (Attribute {field = "name", pk = True, fk = False, aoptions = fromList [("text-alignment",TextAlignment H.HLeft)]}), + A (Attribute {field = "height", pk = False, fk = False, aoptions = fromList [("text-alignment",TextAlignment H.HLeft)]}), + A (Attribute {field = "weight", pk = False, fk = False, aoptions = fromList [("text-alignment",TextAlignment H.HLeft)]}), + A (Attribute {field = "birth date", pk = False, fk = False, aoptions = fromList [("text-alignment",TextAlignment H.HLeft)]}), + A (Attribute {field = "birth_place_id", pk = False, fk = True, aoptions = fromList [("text-alignment",TextAlignment H.HLeft)]}), E (Entity {name = "Birth Place", attribs = [], hoptions = fromList [], eoptions = fromList []}), - A (Attribute {field = "id", pk = True, fk = False, aoptions = fromList []}), - A (Attribute {field = "birth city", pk = False, fk = False, aoptions = fromList []}), - A (Attribute {field = "birth state", pk = False, fk = False, aoptions = fromList []}), - A (Attribute {field = "birth country", pk = False, fk = False, aoptions = fromList []}), + A (Attribute {field = "id", pk = True, fk = False, aoptions = fromList [("text-alignment",TextAlignment H.HLeft)]}), + A (Attribute {field = "birth city", pk = False, fk = False, aoptions = fromList [("text-alignment",TextAlignment H.HLeft)]}), + A (Attribute {field = "birth state", pk = False, fk = False, aoptions = fromList [("text-alignment",TextAlignment H.HLeft)]}), + A (Attribute {field = "birth country", pk = False, fk = False, aoptions = fromList [("text-alignment",TextAlignment H.HLeft)]}), R (Relation {entity1 = "Person", entity2 = "Birth Place", card1 = ZeroPlus , card2 = One, roptions = fromList []})] nfldbText :: Text @@ -165,7 +169,11 @@ |] -data ChunckAST = CE [Entity] | CA [Attribute] | CR [Relation] deriving (Eq) +data ChunckAST = CE [Entity] + | CA [Attribute] + | CR [Relation] + deriving (Eq) + toAST :: ChunckAST -> [AST] toAST (CE x) = map E x toAST (CA x) = map A x @@ -174,8 +182,8 @@ nfldbResult :: (GlobalOptions, [AST]) nfldbResult = (opts, asts) where opts = GlobalOptions {gtoptions = fromList [("label",Label "nfldb Entity-Relationship diagram (condensed)"),("size",FontSize 20.0)], ghoptions = fromList [], geoptions = fromList [], groptions = fromList []} - asts = concatMap toAST $ entities:(attributes ++ [relations]) - entities = CE [ + asts = concatMap toAST $ es:(attributes ++ [relations]) + es = CE [ Entity {name = "player", attribs = [], hoptions = fromList [("bgcolor",BgColor (RGB {red = 208, green = 224, blue = 208}))], eoptions = fromList [("bgcolor",BgColor (RGB {red = 208, green = 224, blue = 208}))] @@ -183,79 +191,79 @@ ] attributes = [ CA [ - Attribute {field = "player_id", pk = True, fk = False, aoptions = fromList [("label",Label "varchar, not null")]}, - Attribute {field = "full_name", pk = False, fk = False, aoptions = fromList [("label",Label "varchar, null")]}, - Attribute {field = "team", pk = False, fk = False, aoptions = fromList [("label",Label "varchar, not null")]}, - Attribute {field = "position", pk = False, fk = False, aoptions = fromList [("label",Label "player_pos, not null")]}, - Attribute {field = "status", pk = False, fk = False, aoptions = fromList [("label",Label "player_status, not null")]} + Attribute {field = "player_id", pk = True, fk = False, aoptions = fromList [("label",Label "varchar, not null"),("text-alignment",TextAlignment H.HLeft)]}, + Attribute {field = "full_name", pk = False, fk = False, aoptions = fromList [("label",Label "varchar, null"),("text-alignment",TextAlignment H.HLeft)]}, + Attribute {field = "team", pk = False, fk = False, aoptions = fromList [("label",Label "varchar, not null"),("text-alignment",TextAlignment H.HLeft)]}, + Attribute {field = "position", pk = False, fk = False, aoptions = fromList [("label",Label "player_pos, not null"),("text-alignment",TextAlignment H.HLeft)]}, + Attribute {field = "status", pk = False, fk = False, aoptions = fromList [("label",Label "player_status, not null"),("text-alignment",TextAlignment H.HLeft)]} ], CE [ Entity {name = "team", attribs = [], hoptions = fromList [("bgcolor",BgColor (RGB {red = 208, green = 224, blue = 208}))], eoptions = fromList [("bgcolor",BgColor (RGB {red = 208, green = 224, blue = 208}))]} ], CA [ - Attribute {field = "team_id", pk = True, fk = False, aoptions = fromList [("label",Label "varchar, not null")]}, - Attribute {field = "city", pk = False, fk = False, aoptions = fromList [("label",Label "varchar, not null")]}, - Attribute {field = "name", pk = False, fk = False, aoptions = fromList [("label",Label "varchar, not null")]} + Attribute {field = "team_id", pk = True, fk = False, aoptions = fromList [("label",Label "varchar, not null"),("text-alignment",TextAlignment H.HLeft)]}, + Attribute {field = "city", pk = False, fk = False, aoptions = fromList [("label",Label "varchar, not null"),("text-alignment",TextAlignment H.HLeft)]}, + Attribute {field = "name", pk = False, fk = False, aoptions = fromList [("label",Label "varchar, not null"),("text-alignment",TextAlignment H.HLeft)]} ], CE [ Entity {name = "game", attribs = [], hoptions = fromList [("bgcolor",BgColor (RGB {red = 236, green = 236, blue = 252}))], eoptions = fromList [("bgcolor",BgColor (RGB {red = 236, green = 236, blue = 252}))]} ], CA [ - Attribute {field = "gsis_id", pk = True, fk = False, aoptions = fromList [("label",Label "gameid, not null")]}, - Attribute {field = "start_time", pk = False, fk = False, aoptions = fromList [("label",Label "utctime, not null")]}, - Attribute {field = "week", pk = False, fk = False, aoptions = fromList [("label",Label "usmallint, not null")]}, - Attribute {field = "season_year", pk = False, fk = False, aoptions = fromList [("label",Label "usmallint, not null")]}, - Attribute {field = "season_type", pk = False, fk = False, aoptions = fromList [("label",Label "season_phase, not null")]}, - Attribute {field = "finished", pk = False, fk = False, aoptions = fromList [("label",Label "boolean, not null")]}, - Attribute {field = "home_team", pk = False, fk = False, aoptions = fromList [("label",Label "varchar, not null")]}, - Attribute {field = "home_score", pk = False, fk = False, aoptions = fromList [("label",Label "usmallint, not null")]}, - Attribute {field = "away_team", pk = False, fk = False, aoptions = fromList [("label",Label "varchar, not null")]}, - Attribute {field = "away_score", pk = False, fk = False, aoptions = fromList [("label",Label "usmallint, not null")]} + Attribute {field = "gsis_id", pk = True, fk = False, aoptions = fromList [("label",Label "gameid, not null"),("text-alignment",TextAlignment H.HLeft)]}, + Attribute {field = "start_time", pk = False, fk = False, aoptions = fromList [("label",Label "utctime, not null"),("text-alignment",TextAlignment H.HLeft)]}, + Attribute {field = "week", pk = False, fk = False, aoptions = fromList [("label",Label "usmallint, not null"),("text-alignment",TextAlignment H.HLeft)]}, + Attribute {field = "season_year", pk = False, fk = False, aoptions = fromList [("label",Label "usmallint, not null"),("text-alignment",TextAlignment H.HLeft)]}, + Attribute {field = "season_type", pk = False, fk = False, aoptions = fromList [("label",Label "season_phase, not null"),("text-alignment",TextAlignment H.HLeft)]}, + Attribute {field = "finished", pk = False, fk = False, aoptions = fromList [("label",Label "boolean, not null"),("text-alignment",TextAlignment H.HLeft)]}, + Attribute {field = "home_team", pk = False, fk = False, aoptions = fromList [("label",Label "varchar, not null"),("text-alignment",TextAlignment H.HLeft)]}, + Attribute {field = "home_score", pk = False, fk = False, aoptions = fromList [("label",Label "usmallint, not null"),("text-alignment",TextAlignment H.HLeft)]}, + Attribute {field = "away_team", pk = False, fk = False, aoptions = fromList [("label",Label "varchar, not null"),("text-alignment",TextAlignment H.HLeft)]}, + Attribute {field = "away_score", pk = False, fk = False, aoptions = fromList [("label",Label "usmallint, not null"),("text-alignment",TextAlignment H.HLeft)]} ], CE [ Entity {name = "drive", attribs = [], hoptions = fromList [("bgcolor",BgColor (RGB {red = 236, green = 236, blue = 252}))], eoptions = fromList [("bgcolor",BgColor (RGB {red = 236, green = 236, blue = 252}))]} ], CA [ - Attribute {field = "gsis_id", pk = True, fk = True, aoptions = fromList [("label",Label "gameid, not null")]}, - Attribute {field = "drive_id", pk = True, fk = False, aoptions = fromList [("label",Label "usmallint, not null")]}, - Attribute {field = "start_field", pk = False, fk = False, aoptions = fromList [("label",Label "field_pos, null")]}, - Attribute {field = "start_time", pk = False, fk = False, aoptions = fromList [("label",Label "game_time, not null")]}, - Attribute {field = "end_field", pk = False, fk = False, aoptions = fromList [("label",Label "field_pos, null")]}, - Attribute {field = "end_time", pk = False, fk = False, aoptions = fromList [("label",Label "game_time, not null")]}, - Attribute {field = "pos_team", pk = False, fk = False, aoptions = fromList [("label",Label "varchar, not null")]}, - Attribute {field = "pos_time", pk = False, fk = False, aoptions = fromList [("label",Label "pos_period, null")]} + Attribute {field = "gsis_id", pk = True, fk = True, aoptions = fromList [("label",Label "gameid, not null"),("text-alignment",TextAlignment H.HLeft)]}, + Attribute {field = "drive_id", pk = True, fk = False, aoptions = fromList [("label",Label "usmallint, not null"),("text-alignment",TextAlignment H.HLeft)]}, + Attribute {field = "start_field", pk = False, fk = False, aoptions = fromList [("label",Label "field_pos, null"),("text-alignment",TextAlignment H.HLeft)]}, + Attribute {field = "start_time", pk = False, fk = False, aoptions = fromList [("label",Label "game_time, not null"),("text-alignment",TextAlignment H.HLeft)]}, + Attribute {field = "end_field", pk = False, fk = False, aoptions = fromList [("label",Label "field_pos, null"),("text-alignment",TextAlignment H.HLeft)]}, + Attribute {field = "end_time", pk = False, fk = False, aoptions = fromList [("label",Label "game_time, not null"),("text-alignment",TextAlignment H.HLeft)]}, + Attribute {field = "pos_team", pk = False, fk = False, aoptions = fromList [("label",Label "varchar, not null"),("text-alignment",TextAlignment H.HLeft)]}, + Attribute {field = "pos_time", pk = False, fk = False, aoptions = fromList [("label",Label "pos_period, null"),("text-alignment",TextAlignment H.HLeft)]} ], CE [ Entity {name = "play", attribs = [], hoptions = fromList [("bgcolor",BgColor (RGB {red = 236, green = 236, blue = 252}))], eoptions = fromList [("bgcolor",BgColor (RGB {red = 236, green = 236, blue = 252}))]} ], CA [ - Attribute {field = "gsis_id", pk = True, fk = True, aoptions = fromList [("label",Label "gameid, not null")]}, - Attribute {field = "drive_id", pk = True, fk = True, aoptions = fromList [("label",Label "usmallint, not null")]}, - Attribute {field = "play_id", pk = True, fk = False, aoptions = fromList [("label",Label "usmallint, not null")]}, - Attribute {field = "time", pk = False, fk = False, aoptions = fromList [("label",Label "game_time, not null")]}, - Attribute {field = "pos_team", pk = False, fk = False, aoptions = fromList [("label",Label "varchar, not null")]}, - Attribute {field = "yardline", pk = False, fk = False, aoptions = fromList [("label",Label "field_pos, null")]}, - Attribute {field = "down", pk = False, fk = False, aoptions = fromList [("label",Label "smallint, null")]}, - Attribute {field = "yards_to_go", pk = False, fk = False, aoptions = fromList [("label",Label "smallint, null")]} + Attribute {field = "gsis_id", pk = True, fk = True, aoptions = fromList [("label",Label "gameid, not null"),("text-alignment",TextAlignment H.HLeft)]}, + Attribute {field = "drive_id", pk = True, fk = True, aoptions = fromList [("label",Label "usmallint, not null"),("text-alignment",TextAlignment H.HLeft)]}, + Attribute {field = "play_id", pk = True, fk = False, aoptions = fromList [("label",Label "usmallint, not null"),("text-alignment",TextAlignment H.HLeft)]}, + Attribute {field = "time", pk = False, fk = False, aoptions = fromList [("label",Label "game_time, not null"),("text-alignment",TextAlignment H.HLeft)]}, + Attribute {field = "pos_team", pk = False, fk = False, aoptions = fromList [("label",Label "varchar, not null"),("text-alignment",TextAlignment H.HLeft)]}, + Attribute {field = "yardline", pk = False, fk = False, aoptions = fromList [("label",Label "field_pos, null"),("text-alignment",TextAlignment H.HLeft)]}, + Attribute {field = "down", pk = False, fk = False, aoptions = fromList [("label",Label "smallint, null"),("text-alignment",TextAlignment H.HLeft)]}, + Attribute {field = "yards_to_go", pk = False, fk = False, aoptions = fromList [("label",Label "smallint, null"),("text-alignment",TextAlignment H.HLeft)]} ], CE [ Entity {name = "play_player", attribs = [], hoptions = fromList [("bgcolor",BgColor (RGB {red = 236, green = 236, blue = 252}))], eoptions = fromList [("bgcolor",BgColor (RGB {red = 236, green = 236, blue = 252}))]} ], CA [ - Attribute {field = "gsis_id", pk = True, fk = True, aoptions = fromList [("label",Label "gameid, not null")]}, - Attribute {field = "drive_id", pk = True, fk = True, aoptions = fromList [("label",Label "usmallint, not null")]}, - Attribute {field = "play_id", pk = True, fk = True, aoptions = fromList [("label",Label "usmallint, not null")]}, - Attribute {field = "player_id", pk = True, fk = True, aoptions = fromList [("label",Label "varchar, not null")]}, - Attribute {field = "team", pk = False, fk = False, aoptions = fromList [("label",Label "varchar, not null")]} + Attribute {field = "gsis_id", pk = True, fk = True, aoptions = fromList [("label",Label "gameid, not null"),("text-alignment",TextAlignment H.HLeft)]}, + Attribute {field = "drive_id", pk = True, fk = True, aoptions = fromList [("label",Label "usmallint, not null"),("text-alignment",TextAlignment H.HLeft)]}, + Attribute {field = "play_id", pk = True, fk = True, aoptions = fromList [("label",Label "usmallint, not null"),("text-alignment",TextAlignment H.HLeft)]}, + Attribute {field = "player_id", pk = True, fk = True, aoptions = fromList [("label",Label "varchar, not null"),("text-alignment",TextAlignment H.HLeft)]}, + Attribute {field = "team", pk = False, fk = False, aoptions = fromList [("label",Label "varchar, not null"),("text-alignment",TextAlignment H.HLeft)]} ], CE [ Entity {name = "meta", attribs = [], hoptions = fromList [("bgcolor",BgColor (RGB {red = 252, green = 236, blue = 236}))], eoptions = fromList [("bgcolor",BgColor (RGB {red = 252, green = 236, blue = 236}))]} ], CA [ - Attribute {field = "version", pk = False, fk = False, aoptions = fromList [("label",Label "smallint, null")]}, - Attribute {field = "season_type", pk = False, fk = False, aoptions = fromList [("label",Label "season_phase, null")]}, - Attribute {field = "season_year", pk = False, fk = False, aoptions = fromList [("label",Label "usmallint, null")]}, - Attribute {field = "week", pk = False, fk = False, aoptions = fromList [("label",Label "usmallint, null")]} + Attribute {field = "version", pk = False, fk = False, aoptions = fromList [("label",Label "smallint, null"),("text-alignment",TextAlignment H.HLeft)]}, + Attribute {field = "season_type", pk = False, fk = False, aoptions = fromList [("label",Label "season_phase, null"),("text-alignment",TextAlignment H.HLeft)]}, + Attribute {field = "season_year", pk = False, fk = False, aoptions = fromList [("label",Label "usmallint, null"),("text-alignment",TextAlignment H.HLeft)]}, + Attribute {field = "week", pk = False, fk = False, aoptions = fromList [("label",Label "usmallint, null"),("text-alignment",TextAlignment H.HLeft)]} ] ] relations = CR [ @@ -271,5 +279,4 @@ Relation {entity1 = "drive", entity2 = "play", card1 = One, card2 = ZeroPlus, roptions = fromList []}, Relation {entity1 = "drive", entity2 = "play_player", card1 = One, card2 = ZeroPlus, roptions = fromList []}, Relation {entity1 = "play", entity2 = "play_player", card1 = One, card2 = ZeroPlus, roptions = fromList []}, - Relation {entity1 = "player", entity2 = "play_player", card1 = One, card2 = ZeroPlus, roptions = fromList []} - ] + Relation {entity1 = "player", entity2 = "play_player", card1 = One, card2 = ZeroPlus, roptions = fromList []} ]