DSH 0.7.6 → 0.7.7
raw patch · 2 files changed
+40/−26 lines, 2 filesdep ~HDBCdep ~HaXmldep ~Pathfinder
Dependency ranges changed: HDBC, HaXml, Pathfinder, array, base, bytestring, containers, convertible, csv, mtl, syb, template-haskell, text, xhtml
Files
- DSH.cabal +15/−15
- src/Database/DSH/XHTML.hs +25/−11
DSH.cabal view
@@ -1,5 +1,5 @@ Name: DSH-Version: 0.7.6+Version: 0.7.7 Synopsis: Database Supported Haskell Description: This is a Haskell library for database-supported program execution. Using@@ -51,21 +51,21 @@ Cabal-version: >= 1.2 Library- Build-depends: base >= 4.2 && < 5,- containers >= 0.3,- array >= 0.3,- syb >= 0.1,- mtl >= 2.0.1,- bytestring >= 0.9,- text >= 0.11,- HDBC >= 2.2,- convertible >= 1.0,- template-haskell >= 2.4,- HaXml >= 1.22,- csv >= 0.1,+ Build-depends: base >= 4.3.1.0 && < 5,+ containers >= 0.4.0.0,+ array >= 0.3.0.2,+ syb >= 0.3,+ mtl >= 2.0.1.0,+ bytestring >= 0.9.1.10,+ text >= 0.11.0.6,+ HDBC >= 2.3.1.0,+ convertible >= 1.0.11.0,+ template-haskell >= 2.5.0.0,+ HaXml >= 1.22.5,+ csv >= 0.1.2, json >= 0.5,- xhtml <= 3000.2.0.2,- Pathfinder >= 0.5.8,+ xhtml >= 3000.2.0.1,+ Pathfinder >= 0.5.9, FerryCore >= 0.4.6.4 Hs-source-dirs: src
src/Database/DSH/XHTML.hs view
@@ -16,17 +16,31 @@ xhtmlExportStdout = xhtmlExportHandle IO.stdout xhtmlExportHandle :: (QA a) => Handle -> [a] -> IO ()-xhtmlExportHandle handle as = IO.hPutStr handle (showHtmlFragment $ (table $ concatHtml $ map (tr . go . toNorm) as) ! [border 1])- where go :: Norm -> Html- go e = case e of- UnitN _ -> td $ stringToHtml "()"- BoolN b _ -> td $ stringToHtml (show b)- CharN c _ -> td $ stringToHtml [c]- IntegerN i _ -> td $ stringToHtml (show i)- DoubleN d _ -> td $ stringToHtml (show d)- TextN t _ -> td $ stringToHtml (Text.unpack t)- TupleN e1 e2 _ -> concatHtml $ map go (e1 : deTuple e2)- ListN es _ -> td $ (table $ concatHtml $ map (tr . go) es) ! [border 1]+xhtmlExportHandle handle as = IO.hPutStr handle (showHtmlFragment $ go 0 0 $ toNorm as)+ where go :: Integer -> Integer -> Norm -> Html+ go tl rl e = case e of+ UnitN _ -> (td $ stringToHtml $ "()") ! [tdAttr tl rl]+ BoolN b _ -> (td $ stringToHtml $ show b) ! [tdAttr tl rl]+ CharN c _ -> (td $ stringToHtml $ [c]) ! [tdAttr tl rl]+ IntegerN i _ -> (td $ stringToHtml $ show i) ! [tdAttr tl rl]+ DoubleN d _ -> (td $ stringToHtml $ show d) ! [tdAttr tl rl]+ TextN t _ -> (td $ stringToHtml $ Text.unpack t) ! [tdAttr tl rl]+ TupleN e1 e2 _ -> (concatHtml $ map (go tl rl) (e1 : deTuple e2))+ ListN es _ -> td $ (table $ concatHtml+ $ map (\(l1,e1) -> tr (go (tl + 1) l1 e1))+ $ zip [0 ..] es+ ) ! [tableAttr]++ tdAttr :: Integer -> Integer -> HtmlAttr+ tdAttr tl rl = case (odd tl,odd rl) of+ (False,False) -> strAttr "style" "text-align:center; min-width:20px; padding:5px; background-color:#EEE;"+ (False,True) -> strAttr "style" "text-align:center; min-width:20px; padding:5px; background-color:#CCC;"+ (True,False) -> strAttr "style" "text-align:center; min-width:20px; padding:5px; background-color:#DDD;"+ (True,True) -> strAttr "style" "text-align:center; min-width:20px; padding:5px; background-color:#E9E9E9;"++ tableAttr :: HtmlAttr+ tableAttr = strAttr "style" "border-spacing:5px;"+ deTuple :: Norm -> [Norm] deTuple (TupleN e1 e2 _) = e1 : deTuple e2