DSH 0.7.5 → 0.7.6

raw patch · 3 files changed

+38/−1 lines, 3 filesdep +xhtml

Dependencies added: xhtml

Files

DSH.cabal +3/−1
src/Database/DSH.hs +2/−0
src/Database/DSH/XHTML.hs +33/−0

DSH.cabal view

@@ -1,5 +1,5 @@ Name:                DSH-Version:             0.7.5+Version:             0.7.6 Synopsis:            Database Supported Haskell Description:   This is a Haskell library for database-supported program execution. Using@@ -64,6 +64,7 @@                      HaXml              >= 1.22,                      csv                >= 0.1,                      json               >= 0.5,+                     xhtml              <= 3000.2.0.2,                      Pathfinder         >= 0.5.8,                      FerryCore          >= 0.4.6.4 @@ -80,5 +81,6 @@                      Database.DSH.Combinators                      Database.DSH.CSV                      Database.DSH.JSON+                     Database.DSH.XHTML                      Database.DSH.Impossible                      Database.DSH.Compile

src/Database/DSH.hs view

@@ -33,6 +33,7 @@    , module Database.DSH.CSV   , module Database.DSH.JSON+  , module Database.DSH.XHTML    , module Data.String   , module Data.Text@@ -46,6 +47,7 @@  import Database.DSH.CSV import Database.DSH.JSON+import Database.DSH.XHTML  import Database.DSH.Combinators

+ src/Database/DSH/XHTML.hs view

@@ -0,0 +1,33 @@+module Database.DSH.XHTML (xhtmlExport, xhtmlExportHandle, xhtmlExportStdout) where++import Database.DSH.Data hiding (table)++import Text.XHtml.Strict++import qualified Data.Text as Text++import qualified System.IO as IO+import System.IO (Handle)++xhtmlExport :: (QA a) => FilePath -> [a] -> IO ()+xhtmlExport file as = IO.withFile file IO.WriteMode (\handle -> xhtmlExportHandle handle as)++xhtmlExportStdout :: (QA a) => [a] -> IO ()+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]++deTuple :: Norm -> [Norm]+deTuple (TupleN e1 e2 _) = e1 : deTuple e2+deTuple n = [n]