0votos

Dibujando esquemas de bases de datos en Haskell

por josejuan hace 5 años

En Haskell también hay API para generar los gráficos (desde código), pero cuando no se está familiarizado con ellas suele ser más cómodo (para mí) hacer un pipe en shell. El balance es API vs FILEFORMAT. Aquí ganó FILEFORMAT.

Te dan un programa que no permite borrar registros de los que dependen otros registros y tienes que modificarlo para que lo permita. Genera los grafos de dependencias para saber que borrar y/o actualizar y como.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
import Data.List (sort, nub) 
import Control.Monad (forM_) 
import Data.Maybe (catMaybes) 
 
getSubGraph :: [String] -> [(String, String)] -> String -> [(String, String)] 
getSubGraph excluding graph node = nub $ sort $ sg ++ concatMap (getSubGraph sg'' graph) sg' 
  where sg = filter (\(a, b) -> a == node && not (b `elem` excluding)) graph 
        sg' = map snd sg 
        sg'' = sg' ++ excluding 
 
allNodes :: [(String, String)] -> [String] 
allNodes = nub . sort . concatMap (\(a, b) -> [a, b])  
 
drawSubGraph :: [(String, String)] -> String -> String 
drawSubGraph graph node = unlines $ [ "## neato -Tpng thisfile > thisfile.png" 
                                    , "digraph " ++ node ++ "_GFX {" 
                                    , "  node [shape=circle]; " ++ node ++ ";" 
                                    , "  node [shape=box]" ++ concatMap ("; "++) snodes ++ ";" 
                                    ] ++ map (\(a, b) -> "  " ++ a ++ " -> " ++ b ++ ";") sgraph ++ 
                                    [ "  overlap = false;" 
                                    , "  label = \"Delete fall: " ++ node ++ ".\";" 
                                    , "  fontsize = 16;" 
                                    , "}" 
                          where sgraph = getSubGraph [] graph node 
                                snodes = filter (node/=) $ allNodes sgraph 
 
main = do 
  relations <- getContents >>= return . catMaybes . map (edge.words) . lines 
  forM_ (allNodes relations) $ \node -> writeFile (node ++ ".gv") (drawSubGraph relations node) 
 
  where edge [a, b] = Just (a, b) 
        edge _ = Nothing 
 
{- 
-- Por ejemplo: 
-- $ runghc relations.hs < relations.lst && ls *gv | while read i; do neato -Tpng "$i" > "$i.png"; done 
 
 
-- relations.lst 
Empresa Empleado 
Empresa Factura 
Empresa Producto 
Empleado Factura 
Empleado Producto 
Empleado RegistroDeAcceso 
Factura FacturaDetalle 
FacturaDetalle Producto 
 
 
 
-- neato - graphviz version 2.30.1 (20130704.1115) 
-} 

Comenta la solución

Tienes que identificarte para poder publicar tu comentario.