{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE UndecidableInstances #-}
module Numeric.LAPACK.Format (
   (##),
   print,
   hyper,
   Format(format),
   FormatArray(formatArray),
   ArrFormat.deflt,
   defltConfig,
   Config(..),
   ) where

import qualified Numeric.LAPACK.Matrix.Type.Private as Matrix
import qualified Numeric.LAPACK.Matrix.Plain.Format as ArrFormat
import qualified Numeric.LAPACK.Matrix.Extent.Private as Extent
import qualified Numeric.LAPACK.Output as Output
import qualified Numeric.LAPACK.Permutation.Private as Perm
import Numeric.LAPACK.Matrix.Type.Private (Matrix)
import Numeric.LAPACK.Matrix.Plain.Format
         (Config(..), defltConfig, FormatArray, formatArray, printfFloating)
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)

import Prelude hiding (print)


infix 0 ##

print :: (Format a) => Config -> a -> IO ()
print :: forall a. Format a => Config -> a -> IO ()
print Config
cfg a
a = 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
$ Config -> a -> Box
forall out. Output out => Config -> a -> out
forall a out. (Format a, Output out) => Config -> a -> out
format Config
cfg a
a

(##) :: (Format a) => a -> String -> IO ()
a
a## :: forall a. Format a => a -> String -> IO ()
##String
cfg = Config -> a -> IO ()
forall a. Format a => Config -> a -> IO ()
print (Config
defltConfig {configFormat :: String
configFormat = String
cfg}) 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) => Config -> a -> Hyper.Graphic
hyper :: forall a. Format a => Config -> a -> Graphic
hyper Config
cfg = Html -> Graphic
Output.hyper (Html -> Graphic) -> (a -> Html) -> a -> Graphic
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> a -> Html
forall out. Output out => Config -> a -> out
forall a out. (Format a, Output out) => Config -> a -> out
format Config
cfg


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

instance Format Int where
   format :: forall out. Output out => Config -> Int -> out
format Config
_cfg = 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 :: forall out. Output out => Config -> Float -> out
format Config
cfg = 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 (Config -> String
configFormat Config
cfg)

instance Format Double where
   format :: forall out. Output out => Config -> Double -> out
format Config
cfg = 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 (Config -> String
configFormat Config
cfg)

instance (Class.Real a) => Format (Complex a) where
   format :: forall out. Output out => Config -> Complex a -> out
format Config
cfg = 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 m. Monoid m => Array (TupleShape (Complex a)) m -> m
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
. Config -> Complex a -> Array (TupleShape (Complex a)) String
forall a. Floating a => Config -> a -> Tuple a String
printfFloating Config
cfg

instance (Format a) => Format [a] where
   format :: forall out. Output out => Config -> [a] -> out
format Config
cfg = [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 (Config -> a -> out
forall out. Output out => Config -> a -> out
forall a out. (Format a, Output out) => Config -> a -> out
format Config
cfg)

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

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

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

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

instance
   (Matrix.Format typ, Matrix.FormatExtra typ xl, Matrix.FormatExtra typ xu,
    Extent.Measure meas, Extent.C vert, Extent.C horiz,
    Shape.C height, Shape.C width, Class.Floating a) =>
   Format
      (Matrix typ xl xu lower upper meas vert horiz height width a) where
   format :: forall out.
Output out =>
Config
-> Matrix typ xl xu lower upper meas vert horiz height width a
-> out
format = Config
-> Matrix typ xl xu lower upper meas vert horiz height width a
-> out
forall typ xl xu meas vert horiz height width a out lower upper.
(Format typ, FormatExtra typ xl, FormatExtra typ xu, Measure meas,
 C vert, C horiz, C height, C width, Floating a, Output out) =>
Config
-> Matrix typ xl xu lower upper meas vert horiz height width a
-> out
forall xl xu meas vert horiz height width a out lower upper.
(FormatExtra typ xl, FormatExtra typ xu, Measure meas, C vert,
 C horiz, C height, C width, Floating a, Output out) =>
Config
-> Matrix typ xl xu lower upper meas vert horiz height width a
-> out
Matrix.format