module Numeric.LAPACK.Output (
   Output (text, above, beside, formatRow, formatColumn, formatTable),
   formatAligned, formatSeparateTriangle, decorateTriangle,
   Separator(..), Style(..),

   (/+/),
   (<+>),
   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
   formatTable :: [[(Separator, Style, out)]] -> out

data Style = Stored | Derived deriving (Style -> Style -> Bool
(Style -> Style -> Bool) -> (Style -> Style -> Bool) -> Eq Style
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Style -> Style -> Bool
$c/= :: Style -> Style -> Bool
== :: Style -> Style -> Bool
$c== :: Style -> Style -> Bool
Eq, Int -> Style
Style -> Int
Style -> [Style]
Style -> Style
Style -> Style -> [Style]
Style -> Style -> Style -> [Style]
(Style -> Style)
-> (Style -> Style)
-> (Int -> Style)
-> (Style -> Int)
-> (Style -> [Style])
-> (Style -> Style -> [Style])
-> (Style -> Style -> [Style])
-> (Style -> Style -> Style -> [Style])
-> Enum Style
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Style -> Style -> Style -> [Style]
$cenumFromThenTo :: Style -> Style -> Style -> [Style]
enumFromTo :: Style -> Style -> [Style]
$cenumFromTo :: Style -> Style -> [Style]
enumFromThen :: Style -> Style -> [Style]
$cenumFromThen :: Style -> Style -> [Style]
enumFrom :: Style -> [Style]
$cenumFrom :: Style -> [Style]
fromEnum :: Style -> Int
$cfromEnum :: Style -> Int
toEnum :: Int -> Style
$ctoEnum :: Int -> Style
pred :: Style -> Style
$cpred :: Style -> Style
succ :: Style -> Style
$csucc :: Style -> Style
Enum)


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

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


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

hyper :: Html -> Hyper.Graphic
hyper :: Html -> Graphic
hyper = Text -> Graphic
Hyper.html (Text -> Graphic) -> (Html -> Text) -> Html -> Graphic
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
TextLazy.toStrict (Text -> Text) -> (Html -> Text) -> Html -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Html -> Text
RenderHtml.renderHtml (Html -> Text) -> (Html -> Html) -> Html -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Html -> Html
unHtml

instance Output Html where
   text :: String -> Html
text = Html -> Html
Html (Html -> Html) -> (String -> Html) -> String -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Html
forall a. ToMarkup a => a -> Html
Html.toHtml
   above :: Html -> Html -> Html
above (Html Html
a) (Html Html
b) = Html -> Html
Html (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html
a Html -> Html -> Html
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Html
Html.br Html -> Html -> Html
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Html
b
   beside :: Html -> Html -> Html
beside (Html Html
a) (Html Html
b) = Html -> Html
Html (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html
a Html -> Html -> Html
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Html
Html.string String
" " Html -> Html -> Html
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Html
b
   formatRow :: [Html] -> Html
formatRow = Html -> Html
Html (Html -> Html) -> ([Html] -> Html) -> [Html] -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Html -> Html
Html.table (Html -> Html) -> ([Html] -> Html) -> [Html] -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Html -> Html
Html.tr (Html -> Html) -> ([Html] -> Html) -> [Html] -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Html -> Html) -> [Html] -> Html
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Html -> Html
td (Html -> Html) -> (Html -> Html) -> Html -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Html -> Html
unHtml)
   formatColumn :: [Html] -> Html
formatColumn = Html -> Html
Html (Html -> Html) -> ([Html] -> Html) -> [Html] -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Html -> Html
Html.table (Html -> Html) -> ([Html] -> Html) -> [Html] -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Html -> Html) -> [Html] -> Html
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Html -> Html
Html.tr (Html -> Html) -> (Html -> Html) -> Html -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Html -> Html
td (Html -> Html) -> (Html -> Html) -> Html -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Html -> Html
unHtml)
   formatTable :: [[(Separator, Style, Html)]] -> Html
formatTable =
      let applyStyle :: Style -> Html -> Html
applyStyle Style
style = case Style
style of Style
Stored -> Html -> Html
forall a. a -> a
id; Style
Derived -> Html -> Html
Html.i in
      Html -> Html
Html (Html -> Html)
-> ([[(Separator, Style, Html)]] -> Html)
-> [[(Separator, Style, Html)]]
-> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Html -> Html
Html.table (Html -> Html)
-> ([[(Separator, Style, Html)]] -> Html)
-> [[(Separator, Style, Html)]]
-> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      ([(Separator, Style, Html)] -> Html)
-> [[(Separator, Style, Html)]] -> Html
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_
         (Html -> Html
Html.tr (Html -> Html)
-> ([(Separator, Style, Html)] -> Html)
-> [(Separator, Style, Html)]
-> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Separator, Style, Html) -> Html)
-> [(Separator, Style, Html)] -> Html
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(Separator
_sep,Style
style,Html
x) -> Html -> Html
td (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Style -> Html -> Html
applyStyle Style
style (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html -> Html
unHtml Html
x))

td :: Html.Html -> Html.Html
td :: Html -> Html
td = Html -> Html
Html.td (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
Attr.align (String -> AttributeValue
forall a. IsString a => String -> a
fromString String
"right")


instance Output Box where
   text :: String -> Box
text = String -> Box
TextBox.text
   above :: Box -> Box -> Box
above = Box -> Box -> Box
(TextBox./+/)
   beside :: Box -> Box -> Box
beside = Box -> Box -> Box
(TextBox.<+>)
   formatRow :: [Box] -> Box
formatRow = Int -> Alignment -> [Box] -> Box
forall (f :: * -> *).
Foldable f =>
Int -> Alignment -> f Box -> Box
TextBox.hsep Int
1 Alignment
TextBox.right
   formatColumn :: [Box] -> Box
formatColumn = Int -> Alignment -> [Box] -> Box
forall (f :: * -> *).
Foldable f =>
Int -> Alignment -> f Box -> Box
TextBox.vsep Int
1 Alignment
TextBox.right
   formatTable :: [[(Separator, Style, Box)]] -> Box
formatTable = [[(Separator, Box)]] -> Box
alignSeparated ([[(Separator, Box)]] -> Box)
-> ([[(Separator, Style, Box)]] -> [[(Separator, Box)]])
-> [[(Separator, Style, Box)]]
-> Box
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(Separator, Style, Box)] -> [(Separator, Box)])
-> [[(Separator, Style, Box)]] -> [[(Separator, Box)]]
forall a b. (a -> b) -> [a] -> [b]
map (((Separator, Style, Box) -> (Separator, Box))
-> [(Separator, Style, Box)] -> [(Separator, Box)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Separator
sep,Style
_style,Box
x) -> (Separator
sep,Box
x)))


formatAligned :: (Foldable f, Output out) => [[f out]] -> out
formatAligned :: [[f out]] -> out
formatAligned = [[(Separator, Style, out)]] -> out
forall out. Output out => [[(Separator, Style, out)]] -> out
formatTable ([[(Separator, Style, out)]] -> out)
-> ([[f out]] -> [[(Separator, Style, out)]]) -> [[f out]] -> out
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([f out] -> [(Separator, Style, out)])
-> [[f out]] -> [[(Separator, Style, out)]]
forall a b. (a -> b) -> [a] -> [b]
map ((f out -> [(Separator, Style, out)])
-> [f out] -> [(Separator, Style, out)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Separator -> Style -> f out -> [(Separator, Style, out)]
forall (f :: * -> *) c a b.
(Foldable f, Output c) =>
a -> b -> f c -> [(a, b, c)]
plainCells Separator
Space Style
Stored))

formatSeparateTriangle :: (Foldable f, Output out) => [[f out]] -> out
formatSeparateTriangle :: [[f out]] -> out
formatSeparateTriangle =
   [[(Separator, Style, out)]] -> out
forall out. Output out => [[(Separator, Style, out)]] -> out
formatTable ([[(Separator, Style, out)]] -> out)
-> ([[f out]] -> [[(Separator, Style, out)]]) -> [[f out]] -> out
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Separator] -> [Style] -> [f out] -> [(Separator, Style, out)])
-> [[f out]] -> [[(Separator, Style, out)]]
forall (f :: * -> *) a b.
([Separator] -> [Style] -> f a -> f b) -> [f a] -> [f b]
decorateTriangle ((([[(Separator, Style, out)]] -> [(Separator, Style, out)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat([[(Separator, Style, out)]] -> [(Separator, Style, out)])
-> ([f out] -> [[(Separator, Style, out)]])
-> [f out]
-> [(Separator, Style, out)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.)(([f out] -> [[(Separator, Style, out)]])
 -> [f out] -> [(Separator, Style, out)])
-> ([Style] -> [f out] -> [[(Separator, Style, out)]])
-> [Style]
-> [f out]
-> [(Separator, Style, out)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) (([Style] -> [f out] -> [[(Separator, Style, out)]])
 -> [Style] -> [f out] -> [(Separator, Style, out)])
-> ([Separator]
    -> [Style] -> [f out] -> [[(Separator, Style, out)]])
-> [Separator]
-> [Style]
-> [f out]
-> [(Separator, Style, out)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Separator -> Style -> f out -> [(Separator, Style, out)])
-> [Separator] -> [Style] -> [f out] -> [[(Separator, Style, out)]]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 Separator -> Style -> f out -> [(Separator, Style, out)]
forall (f :: * -> *) c a b.
(Foldable f, Output c) =>
a -> b -> f c -> [(a, b, c)]
plainCells)

decorateTriangle :: ([Separator] -> [Style] -> f a -> f b) -> [f a] -> [f b]
decorateTriangle :: ([Separator] -> [Style] -> f a -> f b) -> [f a] -> [f b]
decorateTriangle [Separator] -> [Style] -> f a -> f b
f =
   ([Separator] -> [Style] -> f a -> f b)
-> [[Separator]] -> [[Style]] -> [f a] -> [f b]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 [Separator] -> [Style] -> f a -> f b
f
      (([Separator] -> [Separator]) -> [Separator] -> [[Separator]]
forall a. (a -> a) -> a -> [a]
iterate (Separator
SpaceSeparator -> [Separator] -> [Separator]
forall a. a -> [a] -> [a]
:) (Separator
Bar Separator -> [Separator] -> [Separator]
forall a. a -> [a] -> [a]
: Separator -> [Separator]
forall a. a -> [a]
repeat Separator
Space))
      (([Style] -> [Style]) -> [Style] -> [[Style]]
forall a. (a -> a) -> a -> [a]
iterate (Style
DerivedStyle -> [Style] -> [Style]
forall a. a -> [a] -> [a]
:) (Style -> [Style]
forall a. a -> [a]
repeat Style
Stored))

plainCells :: (Foldable f, Output c) => a -> b -> f c -> [(a, b, c)]
plainCells :: a -> b -> f c -> [(a, b, c)]
plainCells a
sep b
style = (c -> (a, b, c)) -> [c] -> [(a, b, c)]
forall a b. (a -> b) -> [a] -> [b]
map ((,,) a
sep b
style) ([c] -> [(a, b, c)]) -> (f c -> [c]) -> f c -> [(a, b, c)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f c -> [c]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Fold.toList


data Separator = Empty | Space | Bar
   deriving (Separator -> Separator -> Bool
(Separator -> Separator -> Bool)
-> (Separator -> Separator -> Bool) -> Eq Separator
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Separator -> Separator -> Bool
$c/= :: Separator -> Separator -> Bool
== :: Separator -> Separator -> Bool
$c== :: Separator -> Separator -> Bool
Eq, Eq Separator
Eq Separator
-> (Separator -> Separator -> Ordering)
-> (Separator -> Separator -> Bool)
-> (Separator -> Separator -> Bool)
-> (Separator -> Separator -> Bool)
-> (Separator -> Separator -> Bool)
-> (Separator -> Separator -> Separator)
-> (Separator -> Separator -> Separator)
-> Ord Separator
Separator -> Separator -> Bool
Separator -> Separator -> Ordering
Separator -> Separator -> Separator
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Separator -> Separator -> Separator
$cmin :: Separator -> Separator -> Separator
max :: Separator -> Separator -> Separator
$cmax :: Separator -> Separator -> Separator
>= :: Separator -> Separator -> Bool
$c>= :: Separator -> Separator -> Bool
> :: Separator -> Separator -> Bool
$c> :: Separator -> Separator -> Bool
<= :: Separator -> Separator -> Bool
$c<= :: Separator -> Separator -> Bool
< :: Separator -> Separator -> Bool
$c< :: Separator -> Separator -> Bool
compare :: Separator -> Separator -> Ordering
$ccompare :: Separator -> Separator -> Ordering
$cp1Ord :: Eq Separator
Ord, Int -> Separator -> ShowS
[Separator] -> ShowS
Separator -> String
(Int -> Separator -> ShowS)
-> (Separator -> String)
-> ([Separator] -> ShowS)
-> Show Separator
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Separator] -> ShowS
$cshowList :: [Separator] -> ShowS
show :: Separator -> String
$cshow :: Separator -> String
showsPrec :: Int -> Separator -> ShowS
$cshowsPrec :: Int -> Separator -> ShowS
Show)

alignSeparated :: [[(Separator, Box)]] -> Box
alignSeparated :: [[(Separator, Box)]] -> Box
alignSeparated =
   Alignment -> [Box] -> Box
forall (f :: * -> *). Foldable f => Alignment -> f Box -> Box
TextBox.hcat Alignment
TextBox.top ([Box] -> Box)
-> ([[(Separator, Box)]] -> [Box]) -> [[(Separator, Box)]] -> Box
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   ([Box] -> Box) -> [[Box]] -> [Box]
forall a b. (a -> b) -> [a] -> [b]
map (Alignment -> [Box] -> Box
forall (f :: * -> *). Foldable f => Alignment -> f Box -> Box
TextBox.vcat Alignment
TextBox.right) ([[Box]] -> [Box])
-> ([[(Separator, Box)]] -> [[Box]])
-> [[(Separator, Box)]]
-> [Box]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   ([(Separator, Box)] -> [[Box]]) -> [[(Separator, Box)]] -> [[Box]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
      ((\([Separator]
seps,[Box]
column) -> [(Separator -> Box) -> [Separator] -> [Box]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Box
TextBox.text (String -> Box) -> (Separator -> String) -> Separator -> Box
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Separator -> String
formatSeparator) [Separator]
seps, [Box]
column])
         (([Separator], [Box]) -> [[Box]])
-> ([(Separator, Box)] -> ([Separator], [Box]))
-> [(Separator, Box)]
-> [[Box]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Separator, Box)] -> ([Separator], [Box])
forall a b. [(a, b)] -> ([a], [b])
unzip) ([[(Separator, Box)]] -> [[Box]])
-> ([[(Separator, Box)]] -> [[(Separator, Box)]])
-> [[(Separator, Box)]]
-> [[Box]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   ([[(Separator, Box)]]
 -> Maybe ([(Separator, Box)], [[(Separator, Box)]]))
-> [[(Separator, Box)]] -> [[(Separator, Box)]]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
List.unfoldr ((Separator, Box)
-> [[(Separator, Box)]]
-> Maybe ([(Separator, Box)], [[(Separator, Box)]])
forall a. a -> [[a]] -> Maybe ([a], [[a]])
viewLAll (Separator
Empty, String -> Box
TextBox.text String
""))

viewLAll :: a -> [[a]] -> Maybe ([a], [[a]])
viewLAll :: a -> [[a]] -> Maybe ([a], [[a]])
viewLAll a
x0 [[a]]
xs =
   Bool -> ([a], [[a]]) -> Maybe ([a], [[a]])
forall a. Bool -> a -> Maybe a
toMaybe (([a] -> Bool) -> [[a]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Bool -> Bool
not(Bool -> Bool) -> ([a] -> Bool) -> [a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.[a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) [[a]]
xs)
      ([(a, [a])] -> ([a], [[a]])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(a, [a])] -> ([a], [[a]])) -> [(a, [a])] -> ([a], [[a]])
forall a b. (a -> b) -> a -> b
$ ([a] -> (a, [a])) -> [[a]] -> [(a, [a])]
forall a b. (a -> b) -> [a] -> [b]
map ((a, [a]) -> Maybe (a, [a]) -> (a, [a])
forall a. a -> Maybe a -> a
fromMaybe (a
x0,[]) (Maybe (a, [a]) -> (a, [a]))
-> ([a] -> Maybe (a, [a])) -> [a] -> (a, [a])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Maybe (a, [a])
forall a. [a] -> Maybe (a, [a])
ListHT.viewL) [[a]]
xs)

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