{-# LANGUAGE FlexibleInstances        #-}
{-# LANGUAGE ConstraintKinds          #-}



module Util.LtdShow (LtdShow(..)) where

import qualified Data.Vector as V

type Array = V.Vector


class LtdShow s where
  ltdShow :: Int -> s -> String

ltdShows :: LtdShow s => Int -> s -> ShowS
ltdShows :: Int -> s -> ShowS
ltdShows Int
n s
o String
s = Int -> s -> String
forall s. LtdShow s => Int -> s -> String
ltdShow Int
n s
o String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

ltdPrint :: LtdShow s => Int -> s -> IO()
ltdPrint :: Int -> s -> IO ()
ltdPrint Int
n = String -> IO ()
putStrLn (String -> IO ()) -> (s -> String) -> s -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> s -> String
forall s. LtdShow s => Int -> s -> String
ltdShow Int
n

newtype LtdShowT a = LtdShow { LtdShowT a -> a
runLtdShow :: a }

instance (Show a) => LtdShow ( LtdShowT a ) where
  ltdShow :: Int -> LtdShowT a -> String
ltdShow Int
n = String -> Int -> ShowS
forall a. (Ord a, Num a) => String -> a -> ShowS
go String
"" (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
16) ShowS -> (LtdShowT a -> String) -> LtdShowT a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show (a -> String) -> (LtdShowT a -> a) -> LtdShowT a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LtdShowT a -> a
forall a. LtdShowT a -> a
runLtdShow where
       go :: String -> a -> ShowS
go (Char
'{':String
um) a
0 String
_ = String
"..}" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> a -> ShowS
go String
um a
0 []
       go (Char
'[':String
um) a
0 String
_ = String
"..]" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> a -> ShowS
go String
um a
0 []
       go (Char
'(':String
um) a
0 String
_ = String
"..)" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> a -> ShowS
go String
um a
0 []
       go [] a
n String
_ | a
na -> a -> Bool
forall a. Ord a => a -> a -> Bool
<=a
0     = String
"..."
       go String
unmatched a
n (Char
c:String
cs)
        | Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"([{"   = Char
c Char -> ShowS
forall a. a -> [a] -> [a]
: String -> a -> ShowS
go (Char
cChar -> ShowS
forall a. a -> [a] -> [a]
:String
unmatched) (a
na -> a -> a
forall a. Num a => a -> a -> a
-a
8) String
cs
       go (Char
'{':String
um) a
n (Char
'}':String
cs) = Char
'}' Char -> ShowS
forall a. a -> [a] -> [a]
: String -> a -> ShowS
go String
um (a
na -> a -> a
forall a. Num a => a -> a -> a
-a
1) String
cs
       go (Char
'[':String
um) a
n (Char
']':String
cs) = Char
']' Char -> ShowS
forall a. a -> [a] -> [a]
: String -> a -> ShowS
go String
um (a
na -> a -> a
forall a. Num a => a -> a -> a
-a
1) String
cs
       go (Char
'(':String
um) a
n (Char
')':String
cs) = Char
')' Char -> ShowS
forall a. a -> [a] -> [a]
: String -> a -> ShowS
go String
um (a
na -> a -> a
forall a. Num a => a -> a -> a
-a
1) String
cs
       go String
unmatched a
n (Char
c:String
cs) = Char
c Char -> ShowS
forall a. a -> [a] -> [a]
: String -> a -> ShowS
go String
unmatched a
n' String
cs
        where n' :: a
n' | Char
cChar -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`([Char
'a'..Char
'z']String -> ShowS
forall a. [a] -> [a] -> [a]
++[Char
'A'..Char
'Z']String -> ShowS
forall a. [a] -> [a] -> [a]
++[Char
'0'..Char
'9'])  = a
na -> a -> a
forall a. Num a => a -> a -> a
-a
1
                 | Bool
otherwise                                    = a
na -> a -> a
forall a. Num a => a -> a -> a
-a
8
       go [] a
_ String
"" = String
""
                                      

instance (LtdShow s) => LtdShow (Array s) where
  ltdShow :: Int -> Array s -> String
ltdShow Int
n Array s
arr 
     | Int
nInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<=Int
1, Int
lInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
0  = String
"[∘∘{" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
l String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"}∘∘]"
     | Bool
otherwise  = (Char
'['Char -> ShowS
forall a. a -> [a] -> [a]
:) ShowS -> (Array s -> String) -> Array s -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ShowS -> ShowS) -> String -> Vector ShowS -> String
forall a b. (a -> b -> b) -> b -> Vector a -> b
V.foldr ((String
"∘ "String -> ShowS
forall a. [a] -> [a] -> [a]
++)ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) String
" ∘]"
                     (Vector ShowS -> String)
-> (Array s -> Vector ShowS) -> Array s -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> s -> ShowS) -> Array s -> Vector ShowS
forall a b. (Int -> a -> b) -> Vector a -> Vector b
V.imap(\Int
i -> Int -> s -> ShowS
forall s. LtdShow s => Int -> s -> ShowS
ltdShows (Int -> s -> ShowS) -> Int -> s -> ShowS
forall a b. (a -> b) -> a -> b
$ Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round(
                                     Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n 
                                      Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
2Double -> Double -> Double
forall a. Floating a => a -> a -> a
**(-Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double -> Double
forall a. Floating a => a -> a
sqrt(Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i)) ))
                     (Array s -> String) -> Array s -> String
forall a b. (a -> b) -> a -> b
$ Array s
arr
   where l :: Int
l = Array s -> Int
forall a. Vector a -> Int
V.length Array s
arr
         
instance (LtdShow l, LtdShow r) => LtdShow (l,r) where
  ltdShow :: Int -> (l, r) -> String
ltdShow Int
n (l
l, r
r) = String
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ l -> String
forall s. LtdShow s => s -> String
pShow l
l String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", " String -> ShowS
forall a. [a] -> [a] -> [a]
++ r -> String
forall s. LtdShow s => s -> String
pShow r
r String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
   where pShow :: LtdShow s => s->String
         pShow :: s -> String
pShow = Int -> s -> String
forall s. LtdShow s => Int -> s -> String
ltdShow (Int -> s -> String) -> Int -> s -> String
forall a b. (a -> b) -> a -> b
$ Int
nInt -> Int -> Int
forall a. Integral a => a -> a -> a
`quot`Int
2


instance (Show p) => LtdShow [p] where
  ltdShow :: Int -> [p] -> String
ltdShow Int
n [p]
l = String
"[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [p] -> ShowS
forall t a. (Eq t, Num t, Show a) => t -> [a] -> ShowS
lsh' Int
n [p]
l String
"]"
   where lsh' :: t -> [a] -> ShowS
lsh' t
0 [a]
_ = (String
"... "String -> ShowS
forall a. [a] -> [a] -> [a]
++)
         lsh' t
_ [] = ShowS
forall a. a -> a
id
         lsh' t
n (a
x:[a]
xs) = ((a -> String
forall a. Show a => a -> String
show a
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", ") String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> [a] -> ShowS
lsh' (t
nt -> t -> t
forall a. Num a => a -> a -> a
-t
1) [a]
xs