erd 0.2.0.0 → 0.2.1.0
raw patch · 12 files changed
+530/−314 lines, 12 filesdep +directorydep +filepathdep +gitrevdep −QuickCheckdep −hspecdep ~containersdep ~graphvizsetup-changed
Dependencies added: directory, filepath, gitrev, yaml
Dependencies removed: QuickCheck, hspec
Dependency ranges changed: containers, graphviz
Files
- Setup.hs +1/−1
- app/Main.hs +41/−54
- changelog.md +17/−1
- erd.cabal +57/−42
- src/Erd/Config.hs +133/−26
- src/Erd/ER.hs +73/−59
- src/Erd/Parse.hs +21/−21
- src/Erd/Render.hs +41/−0
- src/Text/Parsec/Erd/Parser.hs +33/−34
- test/Spec.hs +10/−5
- test/Test/Erd/Render.hs +25/−0
- test/Test/Text/Parsec/Erd/Parser.hs +78/−71
Setup.hs view
@@ -1,2 +1,2 @@-import Distribution.Simple+import Distribution.Simple main = defaultMain
app/Main.hs view
@@ -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.
changelog.md view
@@ -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)
erd.cabal view
@@ -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
src/Erd/Config.hs view
@@ -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>", stdin) , cout = ("<stdout>", 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
src/Erd/ER.hs view
@@ -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)+ ]
src/Erd/Parse.hs view
@@ -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 }
+ src/Erd/Render.hs view
@@ -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
src/Text/Parsec/Erd/Parser.hs view
@@ -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
test/Spec.hs view
@@ -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]
+ test/Test/Erd/Render.hs view
@@ -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]]])]
test/Test/Text/Parsec/Erd/Parser.hs view
@@ -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 []} ]