Output.hs

module Numeric.LAPACK.Output (
   Output
      (text, above, beside, formatRow, formatColumn,
       formatAligned, formatSeparateTriangle),

   (/+/),
   (<+>),
   hyper,
   ) where

import qualified Hyper
import qualified Text.Blaze.Html4.Transitional as Html
import qualified Text.Blaze.Html4.Transitional.Attributes as Attr
import qualified Text.Blaze.Html.Renderer.Text as RenderHtml
import Text.Blaze.Html ((!))

import qualified Text.PrettyPrint.Boxes as TextBox
import Text.PrettyPrint.Boxes (Box)

import qualified Data.Text.Lazy as TextLazy
import qualified Data.Foldable as Fold
import qualified Data.List.HT as ListHT
import qualified Data.List as List
import Data.Foldable (Foldable)
import Data.String (fromString)
import Data.Maybe.HT (toMaybe)
import Data.Maybe (fromMaybe)


class Output out where
   text :: String -> out
   above :: out -> out -> out
   beside :: out -> out -> out
   formatRow, formatColumn :: [out] -> out
   formatAligned :: (Foldable f) => [[f out]] -> out
   formatSeparateTriangle :: (Foldable f) => [[f out]] -> out

(/+/) :: (Output out) => out -> out -> out
(/+/) = above

(<+>) :: (Output out) => out -> out -> out
(<+>) = beside


newtype Html = Html {unHtml :: Html.Html}

hyper :: Html -> Hyper.Graphic
hyper = Hyper.html . TextLazy.toStrict . RenderHtml.renderHtml . unHtml

instance Output Html where
   text = Html . Html.toHtml
   above (Html a) (Html b) = Html $ a >> Html.br >> b
   beside (Html a) (Html b) = Html $ a >> Html.string " " >> b
   formatRow = Html . Html.table . Html.tr . mapM_ (td . unHtml)
   formatColumn = Html . Html.table . mapM_ (Html.tr . td . unHtml)
   formatAligned =
      Html . Html.table .
      mapM_ (Html.tr . mapM_ (td . unHtml) . concatMap Fold.toList)
   formatSeparateTriangle =
      Html . Html.table .
      mapM_ (Html.tr . mapM_ td . concat) .
      zipWith
         (zipWith $ \it -> map (it . unHtml) . Fold.toList)
         (iterate (Html.i:) (repeat id))

td :: Html.Html -> Html.Html
td = Html.td ! Attr.align (fromString "right")


instance Output Box where
   text = TextBox.text
   above = (TextBox./+/)
   beside = (TextBox.<+>)
   formatRow = TextBox.hsep 1 TextBox.right
   formatColumn = TextBox.vsep 1 TextBox.right
   formatAligned = alignSeparated . map (concatMap (attachSeparators Space))
   formatSeparateTriangle =
      alignSeparated . map concat .
      zipWith
         (zipWith attachSeparators)
         (ListHT.outerProduct
            (\row col -> if row==col then Bar else Space)
            [(0::Int)..] [0..])


data Separator = Empty | Space | Bar
   deriving (Eq, Ord, Show)

alignSeparated :: [[(Separator, Box)]] -> Box
alignSeparated =
   TextBox.hcat TextBox.top .
   map (TextBox.vcat TextBox.right) .
   concatMap
      ((\(seps,column) -> [map (TextBox.text . formatSeparator) seps, column])
         . unzip) .
   List.unfoldr (viewLAll (Empty, TextBox.text ""))

viewLAll :: a -> [[a]] -> Maybe ([a], [[a]])
viewLAll x0 xs =
   toMaybe (any (not.null) xs)
      (unzip $ map (fromMaybe (x0,[]) . ListHT.viewL) xs)

formatSeparator :: Separator -> String
formatSeparator sep = case sep of Empty -> ""; Space -> " "; Bar -> "|"

attachSeparators :: (Foldable f) => Separator -> f str -> [(Separator, str)]
attachSeparators sep = zip (sep:repeat Empty) . Fold.toList