{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ConstraintKinds #-}
module Numeric.LAPACK.Format (
   (##),
   hyper,
   Format(format),
   FormatArray(formatArray),
   Type.FormatMatrix(formatMatrix),
   ArrFormat.deflt,
   ) where

import qualified Numeric.LAPACK.Matrix.Plain.Format as ArrFormat
import qualified Numeric.LAPACK.Matrix.Type as Type
import qualified Numeric.LAPACK.Output as Output
import qualified Numeric.LAPACK.Permutation.Private as Perm
import Numeric.LAPACK.Matrix.Plain.Format
         (FormatArray, formatArray, printfComplex)
import Numeric.LAPACK.Output (Output, (/+/))

import qualified Numeric.Netlib.Class as Class

import qualified Data.Array.Comfort.Shape as Shape
import Data.Array.Comfort.Storable (Array)

import qualified Text.PrettyPrint.Boxes as TextBox
import qualified Hyper
import Text.Printf (printf)

import qualified Data.List.Reverse.StrictSpine as ListRev
import Data.Foldable (fold)
import Data.Complex (Complex)
import Data.Char (isSpace)


infix 0 ##

(##) :: (Format a) => a -> String -> IO ()
a
a ## :: a -> String -> IO ()
## String
fmt = String -> IO ()
putStr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String
trim (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Box -> String
TextBox.render (Box -> String) -> Box -> String
forall a b. (a -> b) -> a -> b
$ String -> a -> Box
forall a out. (Format a, Output out) => String -> a -> out
format String
fmt a
a

trim :: String -> String
trim :: String -> String
trim = [String] -> String
unlines ([String] -> String) -> (String -> [String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
ListRev.dropWhile Char -> Bool
isSpace) ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines

hyper :: (Format a) => String -> a -> Hyper.Graphic
hyper :: String -> a -> Graphic
hyper String
fmt = Html -> Graphic
Output.hyper (Html -> Graphic) -> (a -> Html) -> a -> Graphic
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> a -> Html
forall a out. (Format a, Output out) => String -> a -> out
format String
fmt


class Format a where
   format :: (Output out) => String -> a -> out

instance Format Int where
   format :: String -> Int -> out
format String
_fmt = String -> out
forall out. Output out => String -> out
Output.text (String -> out) -> (Int -> String) -> Int -> out
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show

instance Format Float where
   format :: String -> Float -> out
format String
fmt = String -> out
forall out. Output out => String -> out
Output.text (String -> out) -> (Float -> String) -> Float -> out
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Float -> String
forall r. PrintfType r => String -> r
printf String
fmt

instance Format Double where
   format :: String -> Double -> out
format String
fmt = String -> out
forall out. Output out => String -> out
Output.text (String -> out) -> (Double -> String) -> Double -> out
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Double -> String
forall r. PrintfType r => String -> r
printf String
fmt

instance (Class.Real a) => Format (Complex a) where
   format :: String -> Complex a -> out
format String
fmt = String -> out
forall out. Output out => String -> out
Output.text (String -> out) -> (Complex a -> String) -> Complex a -> out
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array (TupleShape (Complex a)) String -> String
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (Array (TupleShape (Complex a)) String -> String)
-> (Complex a -> Array (TupleShape (Complex a)) String)
-> Complex a
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Complex a -> Array (TupleShape (Complex a)) String
forall a. Real a => String -> Complex a -> Tuple (Complex a) String
printfComplex String
fmt

instance (Format a) => Format [a] where
   format :: String -> [a] -> out
format String
fmt = [out] -> out
forall out. Output out => [out] -> out
Output.formatColumn ([out] -> out) -> ([a] -> [out]) -> [a] -> out
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> out) -> [a] -> [out]
forall a b. (a -> b) -> [a] -> [b]
map (String -> a -> out
forall a out. (Format a, Output out) => String -> a -> out
format String
fmt)

instance (Format a, Format b) => Format (a,b) where
   format :: String -> (a, b) -> out
format String
fmt (a
a,b
b) = String -> a -> out
forall a out. (Format a, Output out) => String -> a -> out
format String
fmt a
a out -> out -> out
forall out. Output out => out -> out -> out
/+/ String -> b -> out
forall a out. (Format a, Output out) => String -> a -> out
format String
fmt b
b

instance (Format a, Format b, Format c) => Format (a,b,c) where
   format :: String -> (a, b, c) -> out
format String
fmt (a
a,b
b,c
c) = String -> a -> out
forall a out. (Format a, Output out) => String -> a -> out
format String
fmt a
a out -> out -> out
forall out. Output out => out -> out -> out
/+/ String -> b -> out
forall a out. (Format a, Output out) => String -> a -> out
format String
fmt b
b out -> out -> out
forall out. Output out => out -> out -> out
/+/ String -> c -> out
forall a out. (Format a, Output out) => String -> a -> out
format String
fmt c
c

instance (Shape.C sh) => Format (Perm.Permutation sh) where
   format :: String -> Permutation sh -> out
format String
_fmt = Permutation sh -> out
forall sh out. (C sh, Output out) => Permutation sh -> out
Perm.format

instance (FormatArray sh, Class.Floating a) => Format (Array sh a) where
   format :: String -> Array sh a -> out
format = String -> Array sh a -> out
forall sh a out.
(FormatArray sh, Floating a, Output out) =>
String -> Array sh a -> out
formatArray

instance
   (Type.FormatMatrix typ, Class.Floating a) =>
      Format (Type.Matrix typ a) where
   format :: String -> Matrix typ a -> out
format = String -> Matrix typ a -> out
forall typ a out.
(FormatMatrix typ, Floating a, Output out) =>
String -> Matrix typ a -> out
Type.formatMatrix