{-# language LambdaCase #-}
{-# options_ghc -Wno-unused-imports #-}
module Data.RPTree.Draw where
import Data.List (intercalate)
import Text.Printf (PrintfArg, printf)
import qualified Text.PrettyPrint.Boxes as B (Box, render, emptyBox, vcat, hcat, text, top, bottom, center1)
import qualified Data.ByteString.Lazy as LBS (ByteString, writeFile)
import qualified Data.ByteString.Builder as BSB (Builder, toLazyByteString, string7, charUtf8)
import qualified Data.Vector as V (Vector, replicateM)
import qualified Data.Vector.Generic as VG (Vector(..), map, sum, unfoldr, unfoldrM, length, replicateM, (!))
import qualified Data.Vector.Unboxed as VU (Unbox)
import Data.RPTree.Internal (RPTree(..), RPT(..), DVector, toListDv)
writeCsv :: (Show a, Show b, VU.Unbox a) =>
FilePath
-> [(DVector a, b)]
-> IO ()
writeCsv :: FilePath -> [(DVector a, b)] -> IO ()
writeCsv FilePath
fp [(DVector a, b)]
ds = FilePath -> ByteString -> IO ()
LBS.writeFile FilePath
fp (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ Builder -> ByteString
BSB.toLazyByteString (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ [(DVector a, b)] -> Builder
forall a b.
(Show a, Show b, Unbox a) =>
[(DVector a, b)] -> Builder
toCsv [(DVector a, b)]
ds
toCsvRow :: (Show a, Show b, VU.Unbox a) =>
DVector a
-> b
-> BSB.Builder
toCsvRow :: DVector a -> b -> Builder
toCsvRow DVector a
dv b
i = FilePath -> Builder
BSB.string7 (FilePath -> Builder) -> FilePath -> Builder
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate FilePath
"," [a -> FilePath
forall a. Show a => a -> FilePath
show a
x, a -> FilePath
forall a. Show a => a -> FilePath
show a
y, b -> FilePath
forall a. Show a => a -> FilePath
show b
i]
where
(a
x:a
y:[a]
_) = DVector a -> [a]
forall a. Unbox a => DVector a -> [a]
toListDv DVector a
dv
toCsv :: (Show a, Show b, VU.Unbox a) =>
[(DVector a, b)] -> BSB.Builder
toCsv :: [(DVector a, b)] -> Builder
toCsv [(DVector a, b)]
rs = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [DVector a -> b -> Builder
forall a b. (Show a, Show b, Unbox a) => DVector a -> b -> Builder
toCsvRow DVector a
r b
i Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
BSB.charUtf8 Char
'\n' | (DVector a
r, b
i) <- [(DVector a, b)]
rs]
draw :: (Show a, Boxed a, PrintfArg v) => RPTree v a -> IO ()
draw :: RPTree v a -> IO ()
draw = RPT v a -> IO ()
forall a v. (Show a, Boxed a, PrintfArg v) => RPT v a -> IO ()
drawRPT (RPT v a -> IO ())
-> (RPTree v a -> RPT v a) -> RPTree v a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RPTree v a -> RPT v a
forall d a. RPTree d a -> RPT d a
_rpTree
drawRPT :: (Show a, Boxed a, PrintfArg v) => RPT v a -> IO ()
drawRPT :: RPT v a -> IO ()
drawRPT = FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> (RPT v a -> FilePath) -> RPT v a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RPT v a -> FilePath
forall a v. (Show a, Boxed a, PrintfArg v) => RPT v a -> FilePath
toStringRPT
toStringRPT :: (Show a, Boxed a, PrintfArg v) => RPT v a -> String
toStringRPT :: RPT v a -> FilePath
toStringRPT = Box -> FilePath
B.render (Box -> FilePath) -> (RPT v a -> Box) -> RPT v a -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RPT v a -> Box
forall a v. (Show a, Boxed a, PrintfArg v) => RPT v a -> Box
toBox
toBox :: (Show a, Boxed a, PrintfArg v) => RPT v a -> B.Box
toBox :: RPT v a -> Box
toBox = \case
(Bin v
thr Margin v
_ RPT v a
tl RPT v a
tr) ->
FilePath -> Box
txt (v -> FilePath
forall t t. (PrintfArg t, PrintfType t) => t -> t
node v
thr) Box -> Box -> Box
`stack` (RPT v a -> Box
forall a v. (Show a, Boxed a, PrintfArg v) => RPT v a -> Box
toBox RPT v a
tl Box -> Box -> Box
`byside` RPT v a -> Box
forall a v. (Show a, Boxed a, PrintfArg v) => RPT v a -> Box
toBox RPT v a
tr)
Tip a
xs -> a -> Box
forall a. Boxed a => a -> Box
boxed a
xs
where
node :: t -> t
node t
x = FilePath -> t -> t
forall r. PrintfType r => FilePath -> r
printf FilePath
"%5.2f" t
x
class Boxed a where
boxed :: a -> B.Box
instance (Show a) => Boxed [a] where
boxed :: [a] -> Box
boxed = (Box -> a -> Box) -> Box -> [a] -> Box
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Box
bx a
x -> Box
bx Box -> Box -> Box
`stack` FilePath -> Box
txt (a -> FilePath
forall a. Show a => a -> FilePath
show a
x)) (Box -> [a] -> Box) -> Box -> [a] -> Box
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Box
B.emptyBox Int
0 Int
0
instance Boxed () where
boxed :: () -> Box
boxed ()
_ = FilePath -> Box
txt FilePath
"*"
tipData :: (Show a, Foldable t) => t a -> B.Box
tipData :: t a -> Box
tipData = (Box -> a -> Box) -> Box -> t a -> Box
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Box
bx a
x -> Box
bx Box -> Box -> Box
`stack` FilePath -> Box
txt (a -> FilePath
forall a. Show a => a -> FilePath
show a
x)) (Box -> t a -> Box) -> Box -> t a -> Box
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Box
B.emptyBox Int
1 Int
1
txt :: String -> B.Box
txt :: FilePath -> Box
txt FilePath
t = Box
spc Box -> Box -> Box
`byside` FilePath -> Box
B.text FilePath
t Box -> Box -> Box
`byside` Box
spc
where spc :: Box
spc = Int -> Int -> Box
B.emptyBox Int
1 Int
1
byside :: B.Box -> B.Box -> B.Box
byside :: Box -> Box -> Box
byside Box
l Box
r = Alignment -> [Box] -> Box
forall (f :: * -> *). Foldable f => Alignment -> f Box -> Box
B.hcat Alignment
B.top [Box
l, Box
r]
stack :: B.Box -> B.Box -> B.Box
stack :: Box -> Box -> Box
stack Box
t Box
b = Alignment -> [Box] -> Box
forall (f :: * -> *). Foldable f => Alignment -> f Box -> Box
B.vcat Alignment
B.center1 [Box
t, Box
b]