{- |
module: Factor.Util
description: Utility functions
license: MIT

maintainer: Joe Leslie-Hurd <joe@gilith.com>
stability: provisional
portability: portable
-}

module Factor.Util
where

import Control.Monad (ap,liftM)
import qualified Data.Bits as Bits
import qualified Data.List as List
import Data.Maybe (isJust)
import qualified Data.Time as Time
import System.IO (hPutStrLn,stderr)
import System.Random (RandomGen)
import qualified System.Random as Random

-------------------------------------------------------------------------------
-- Factoring monad
-------------------------------------------------------------------------------

type Factor f a = Either f a

runFactor :: Show f => Factor f a -> a
runFactor :: Factor f a -> a
runFactor (Left f
f) = [Char] -> a
forall a. HasCallStack => [Char] -> a
error ([Char] -> a) -> [Char] -> a
forall a b. (a -> b) -> a -> b
$ [Char]
"found a factor " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ f -> [Char]
forall a. Show a => a -> [Char]
show f
f
runFactor (Right a
a) = a
a

-------------------------------------------------------------------------------
-- Verbose monad
-------------------------------------------------------------------------------

data Verbose a =
    ResultVerbose a
  | CommentVerbose String (Verbose a)

instance Functor Verbose where
  fmap :: (a -> b) -> Verbose a -> Verbose b
fmap = (a -> b) -> Verbose a -> Verbose b
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM

instance Applicative Verbose where
  pure :: a -> Verbose a
pure = a -> Verbose a
forall a. a -> Verbose a
ResultVerbose
  <*> :: Verbose (a -> b) -> Verbose a -> Verbose b
(<*>) = Verbose (a -> b) -> Verbose a -> Verbose b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance Monad Verbose where
  ResultVerbose a
a >>= :: Verbose a -> (a -> Verbose b) -> Verbose b
>>= a -> Verbose b
f = a -> Verbose b
f a
a
  CommentVerbose [Char]
s Verbose a
v >>= a -> Verbose b
f = [Char] -> Verbose b -> Verbose b
forall a. [Char] -> Verbose a -> Verbose a
CommentVerbose [Char]
s (Verbose a
v Verbose a -> (a -> Verbose b) -> Verbose b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> Verbose b
f)

timestampFormat :: String
timestampFormat :: [Char]
timestampFormat = [Char]
"[%Y-%m-%d %H:%M:%S]"

comment :: String -> Verbose ()
comment :: [Char] -> Verbose ()
comment [Char]
s = [Char] -> Verbose () -> Verbose ()
forall a. [Char] -> Verbose a -> Verbose a
CommentVerbose [Char]
s (() -> Verbose ()
forall a. a -> Verbose a
ResultVerbose ())

runQuiet :: Verbose a -> a
runQuiet :: Verbose a -> a
runQuiet (ResultVerbose a
a) = a
a
runQuiet (CommentVerbose [Char]
_ Verbose a
v) = Verbose a -> a
forall a. Verbose a -> a
runQuiet Verbose a
v

runVerbose :: Verbose a -> IO a
runVerbose :: Verbose a -> IO a
runVerbose (ResultVerbose a
a) = a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
runVerbose (CommentVerbose [Char]
s Verbose a
v) = do { Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr [Char]
s ; Verbose a -> IO a
forall a. Verbose a -> IO a
runVerbose Verbose a
v }

runTimestampVerbose :: Verbose a -> IO a
runTimestampVerbose :: Verbose a -> IO a
runTimestampVerbose (ResultVerbose a
a) = a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
runTimestampVerbose (CommentVerbose [Char]
s Verbose a
v) = do
    ([Char] -> IO ()) -> [[Char]] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ [Char] -> IO ()
stamp ([[Char]] -> IO ()) -> [[Char]] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> [[Char]]
lines [Char]
s
    Verbose a -> IO a
forall a. Verbose a -> IO a
runTimestampVerbose Verbose a
v
  where
    stamp :: [Char] -> IO ()
stamp [Char]
l = do
        [Char]
t <- ZonedTime -> [Char]
fmt (ZonedTime -> [Char]) -> IO ZonedTime -> IO [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO ZonedTime
Time.getZonedTime
        Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
t [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
l

    fmt :: ZonedTime -> [Char]
fmt = TimeLocale -> [Char] -> ZonedTime -> [Char]
forall t. FormatTime t => TimeLocale -> [Char] -> t -> [Char]
Time.formatTime TimeLocale
Time.defaultTimeLocale [Char]
timestampFormat

-------------------------------------------------------------------------------
-- Integer divides relation
-------------------------------------------------------------------------------

isUnit :: Integer -> Bool
isUnit :: Integer -> Bool
isUnit Integer
1 = Bool
True
isUnit (-1) = Bool
True
isUnit Integer
_ = Bool
False

divides :: Integer -> Integer -> Bool
divides :: Integer -> Integer -> Bool
divides Integer
_ Integer
0 = Bool
True
divides Integer
0 Integer
_ = Bool
False
divides Integer
m Integer
n = Integer
n Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
m Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0

properDivisor :: Integer -> Integer -> Bool
properDivisor :: Integer -> Integer -> Bool
properDivisor Integer
m Integer
n = Integer -> Integer -> Bool
divides Integer
m Integer
n Bool -> Bool -> Bool
&& Bool -> Bool
not (Integer -> Bool
isUnit Integer
m) Bool -> Bool -> Bool
&& Integer -> Integer
forall a. Num a => a -> a
abs Integer
m Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer -> Integer
forall a. Num a => a -> a
abs Integer
n

-------------------------------------------------------------------------------
-- Integer division
-------------------------------------------------------------------------------

division :: Integer -> Integer -> (Integer,Integer)
division :: Integer -> Integer -> (Integer, Integer)
division Integer
_ Integer
0 = [Char] -> (Integer, Integer)
forall a. HasCallStack => [Char] -> a
error [Char]
"Integer division by zero"
division Integer
m Integer
n = if Integer
r Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 then (Integer
q Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1, Integer
r Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
n) else (Integer
q,Integer
r)
  where (Integer
q,Integer
r) = (Integer
m Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
n, Integer
m Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
n)

divisionClosest :: Integer -> Integer -> (Integer,Integer)
divisionClosest :: Integer -> Integer -> (Integer, Integer)
divisionClosest Integer
m Integer
n =
    if Integer
abs_n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
2Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
r then (if Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 then Integer
q Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1 else Integer
q Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1, Integer
r Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
abs_n) else (Integer
q,Integer
r)
  where
    (Integer
q,Integer
r) = Integer -> Integer -> (Integer, Integer)
division Integer
m Integer
n
    abs_n :: Integer
abs_n = Integer -> Integer
forall a. Num a => a -> a
abs Integer
n

exactQuotient :: Integer -> Integer -> Maybe Integer
exactQuotient :: Integer -> Integer -> Maybe Integer
exactQuotient Integer
0 = [Char] -> Integer -> Maybe Integer
forall a. HasCallStack => [Char] -> a
error [Char]
"Integer exact quotient: division by 0"
exactQuotient Integer
1 = Integer -> Maybe Integer
forall a. a -> Maybe a
Just
exactQuotient (-1) = Integer -> Maybe Integer
forall a. a -> Maybe a
Just (Integer -> Maybe Integer)
-> (Integer -> Integer) -> Integer -> Maybe Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Integer
forall a. Num a => a -> a
negate
exactQuotient Integer
m = \Integer
n -> if Integer -> Integer -> Bool
divides Integer
m Integer
n then Integer -> Maybe Integer
forall a. a -> Maybe a
Just (Integer
n Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
m) else Maybe Integer
forall a. Maybe a
Nothing

divPower :: Integer -> Integer -> (Integer,Integer)
divPower :: Integer -> Integer -> (Integer, Integer)
divPower Integer
m | Integer
m Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
1 = [Char] -> Integer -> (Integer, Integer)
forall a. HasCallStack => [Char] -> a
error [Char]
"divPower argument must be positive non-unit"
divPower Integer
m | Bool
otherwise = \Integer
n -> if Integer
n Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 then (Integer
0,Integer
0) else Integer -> Integer -> (Integer, Integer)
forall a. Num a => a -> Integer -> (a, Integer)
go Integer
0 Integer
n
  where go :: a -> Integer -> (a, Integer)
go a
k Integer
n = if Integer -> Integer -> Bool
divides Integer
m Integer
n then a -> Integer -> (a, Integer)
go (a
ka -> a -> a
forall a. Num a => a -> a -> a
+a
1) (Integer
n Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
m) else (a
k,Integer
n)

-------------------------------------------------------------------------------
-- Integer factorial
-------------------------------------------------------------------------------

factorial :: Integer -> Integer
factorial :: Integer -> Integer
factorial Integer
n | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
1 = Integer
1
factorial Integer
n = Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer -> Integer
factorial (Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1)

-------------------------------------------------------------------------------
-- Integer greatest common divisor
-------------------------------------------------------------------------------

egcd :: Integer -> Integer -> (Integer,(Integer,Integer))
egcd :: Integer -> Integer -> (Integer, (Integer, Integer))
egcd Integer
m Integer
0 = if Integer
m Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 then (-Integer
m,(-Integer
1,Integer
0)) else (Integer
m,(Integer
1,Integer
0))
egcd Integer
m Integer
n =
    (Integer
g, (Integer
t, Integer
s Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
qInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
t))
  where
    (Integer
g,(Integer
s,Integer
t)) = Integer -> Integer -> (Integer, (Integer, Integer))
egcd Integer
n Integer
r
    (Integer
q,Integer
r) = Integer -> Integer -> (Integer, Integer)
division Integer
m Integer
n

coprime :: Integer -> Integer -> Bool
coprime :: Integer -> Integer -> Bool
coprime Integer
m Integer
n = Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
gcd Integer
m Integer
n Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
1

chineseRemainder :: Integer -> Integer -> Integer -> Integer -> Integer
chineseRemainder :: Integer -> Integer -> Integer -> Integer -> Integer
chineseRemainder Integer
m Integer
n =
    \Integer
i Integer
j -> (Integer
iInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
tn Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
jInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
sm) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
mn
  where
    (Integer
_,(Integer
s,Integer
t)) = Integer -> Integer -> (Integer, (Integer, Integer))
egcd Integer
m Integer
n
    mn :: Integer
mn = Integer
m Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
n
    sm :: Integer
sm = Integer
s Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
m
    tn :: Integer
tn = Integer
t Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
n

-------------------------------------------------------------------------------
-- Integer nth root function [1] satisfying
--
--  0 < n /\ 0 <= k /\ p = nthRoot n k
-- ------------------------------------
--        p^n <= k < (p+1)^n
--
-- 1. https://en.wikipedia.org/wiki/Nth_root_algorithm
-------------------------------------------------------------------------------

nthRoot :: Integer -> Integer -> Integer
nthRoot :: Integer -> Integer -> Integer
nthRoot Integer
1 Integer
k = Integer
k
nthRoot Integer
_ Integer
0 = Integer
0
nthRoot Integer
n Integer
k = if Integer
k Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
n' then Integer
1 else Integer -> Integer
go (Integer
k Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
n')
  where
    n' :: Integer
n' = Integer -> Integer
forall a. Integral a => a -> Integer
toInteger Integer
n
    go :: Integer -> Integer
go Integer
x = if Integer
x' Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
x then Integer
x else Integer -> Integer
go Integer
x'
      where
        x' :: Integer
x' = ((Integer
n' Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
k Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` (Integer
x Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ (Integer
n' Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1))) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
n'

nthRootClosest :: Integer -> Integer -> Integer
nthRootClosest :: Integer -> Integer -> Integer
nthRootClosest Integer
n Integer
k =
    if (Integer
pInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
1)Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
k Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
k Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
pInteger -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
n then Integer
pInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
1 else Integer
p
  where
    p :: Integer
p = Integer -> Integer -> Integer
nthRoot Integer
n Integer
k

-------------------------------------------------------------------------------
-- Integer powers
-------------------------------------------------------------------------------

destNthPower :: Integer -> Integer -> Maybe Integer
destNthPower :: Integer -> Integer -> Maybe Integer
destNthPower Integer
n Integer
k = if Integer
r Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
n Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
k then Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
r else Maybe Integer
forall a. Maybe a
Nothing
  where r :: Integer
r = Integer -> Integer -> Integer
nthRoot Integer
n Integer
k

isNthPower :: Integer -> Integer -> Bool
isNthPower :: Integer -> Integer -> Bool
isNthPower Integer
n = Maybe Integer -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Integer -> Bool)
-> (Integer -> Maybe Integer) -> Integer -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Integer -> Maybe Integer
destNthPower Integer
n

destSquare :: Integer -> Maybe Integer
destSquare :: Integer -> Maybe Integer
destSquare = Integer -> Integer -> Maybe Integer
destNthPower Integer
2

isSquare :: Integer -> Bool
isSquare :: Integer -> Bool
isSquare = Integer -> Integer -> Bool
isNthPower Integer
2

-------------------------------------------------------------------------------
-- Integer bits
-------------------------------------------------------------------------------

type Width = Int

-- Caution: returns an infinite list for negative arguments
bitsInteger :: Integer -> [Bool]
bitsInteger :: Integer -> [Bool]
bitsInteger = (Integer -> Bool) -> [Integer] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> Bool
forall a. Integral a => a -> Bool
odd ([Integer] -> [Bool])
-> (Integer -> [Integer]) -> Integer -> [Bool]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Bool) -> [Integer] -> [Integer]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
(/=) Integer
0) ([Integer] -> [Integer])
-> (Integer -> [Integer]) -> Integer -> [Integer]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Integer) -> Integer -> [Integer]
forall a. (a -> a) -> a -> [a]
iterate ((Integer -> Int -> Integer) -> Int -> Integer -> Integer
forall a b c. (a -> b -> c) -> b -> a -> c
flip Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
Bits.shiftR Int
1)

widthInteger :: Integer -> Width
widthInteger :: Integer -> Int
widthInteger Integer
n | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 = [Char] -> Int
forall a. HasCallStack => [Char] -> a
error [Char]
"width only defined for nonnegative integers"
widthInteger Integer
n | Bool
otherwise = [Bool] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Bool] -> Int) -> [Bool] -> Int
forall a b. (a -> b) -> a -> b
$ Integer -> [Bool]
bitsInteger Integer
n

widthIntegerToString :: Integer -> String
widthIntegerToString :: Integer -> [Char]
widthIntegerToString Integer
n = Int -> [Char]
forall a. Show a => a -> [Char]
show (Integer -> Int
widthInteger Integer
n) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"-bit integer " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Integer -> [Char]
forall a. Show a => a -> [Char]
show Integer
n

uniformInteger :: RandomGen r => Width -> r -> (Integer,r)
uniformInteger :: Int -> r -> (Integer, r)
uniformInteger Int
w | Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = [Char] -> r -> (Integer, r)
forall a. HasCallStack => [Char] -> a
error ([Char] -> r -> (Integer, r)) -> [Char] -> r -> (Integer, r)
forall a b. (a -> b) -> a -> b
$ [Char]
"no integers with width " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
w
uniformInteger Int
0 = (,) Integer
0
uniformInteger Int
w = Int -> Integer -> r -> (Integer, r)
forall t t t.
(Eq t, Num t, Num t, RandomGen t) =>
t -> t -> t -> (t, t)
gen (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Integer
1
  where
    gen :: t -> t -> t -> (t, t)
gen t
0 t
n t
r = (t
n,t
r)
    gen t
i t
n t
r = t -> t -> t -> (t, t)
gen (t
i t -> t -> t
forall a. Num a => a -> a -> a
- t
1) (t
2 t -> t -> t
forall a. Num a => a -> a -> a
* t
n t -> t -> t
forall a. Num a => a -> a -> a
+ (if Bool
b then t
1 else t
0)) t
r'
      where (Bool
b,t
r') = t -> (Bool, t)
forall a g. (Random a, RandomGen g) => g -> (a, g)
Random.random t
r

uniformOddInteger :: RandomGen r => Width -> r -> (Integer,r)
uniformOddInteger :: Int -> r -> (Integer, r)
uniformOddInteger Int
w r
_ | Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 = [Char] -> (Integer, r)
forall a. HasCallStack => [Char] -> a
error ([Char] -> (Integer, r)) -> [Char] -> (Integer, r)
forall a b. (a -> b) -> a -> b
$ [Char]
"no odd integers with width " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
w
uniformOddInteger Int
w r
r = (Integer
2Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1, r
r')
  where (Integer
n,r
r') = Int -> r -> (Integer, r)
forall r. RandomGen r => Int -> r -> (Integer, r)
uniformInteger (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) r
r

-------------------------------------------------------------------------------
-- Base 2 log
-------------------------------------------------------------------------------

type Log2Integer = Double
type Log2Probability = Double

log2 :: Double -> Double
log2 :: Double -> Double
log2 = Double -> Double -> Double
forall a. Floating a => a -> a -> a
logBase Double
2.0

log2e :: Double
log2e :: Double
log2e = Double -> Double
log2 (Double -> Double
forall a. Floating a => a -> a
exp Double
1.0)

log2Integer :: Integer -> Log2Integer
log2Integer :: Integer -> Double
log2Integer Integer
n | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
0 = [Char] -> Double
forall a. HasCallStack => [Char] -> a
error [Char]
"log only defined for positive integers"
log2Integer Integer
n =
    Integer -> Double
forall a. Num a => Integer -> a
fromInteger (Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
k) Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double -> Double
log2 (Integer -> Double
forall a. Num a => Integer -> a
fromInteger (Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
Bits.shiftR Integer
n Int
k))
  where
    k :: Int
k = if Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
p then Int
0 else Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
p
    w :: Int
w = Integer -> Int
widthInteger Integer
n
    p :: Int
p = Int
53

logInteger :: Integer -> Double
logInteger :: Integer -> Double
logInteger Integer
n = Integer -> Double
log2Integer Integer
n Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
log2e

exp2Integer :: Log2Integer -> Integer
exp2Integer :: Double -> Integer
exp2Integer Double
x = Double -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double
2.0 Double -> Double -> Double
forall a. Floating a => a -> a -> a
** Double
x)

-------------------------------------------------------------------------------
-- The Jacobi symbol (m/n)
--
-- The n argument must be a positive odd integer
-------------------------------------------------------------------------------

data Residue = Residue | NonResidue | ZeroResidue
  deriving (Residue -> Residue -> Bool
(Residue -> Residue -> Bool)
-> (Residue -> Residue -> Bool) -> Eq Residue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Residue -> Residue -> Bool
$c/= :: Residue -> Residue -> Bool
== :: Residue -> Residue -> Bool
$c== :: Residue -> Residue -> Bool
Eq,Eq Residue
Eq Residue
-> (Residue -> Residue -> Ordering)
-> (Residue -> Residue -> Bool)
-> (Residue -> Residue -> Bool)
-> (Residue -> Residue -> Bool)
-> (Residue -> Residue -> Bool)
-> (Residue -> Residue -> Residue)
-> (Residue -> Residue -> Residue)
-> Ord Residue
Residue -> Residue -> Bool
Residue -> Residue -> Ordering
Residue -> Residue -> Residue
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 :: Residue -> Residue -> Residue
$cmin :: Residue -> Residue -> Residue
max :: Residue -> Residue -> Residue
$cmax :: Residue -> Residue -> Residue
>= :: Residue -> Residue -> Bool
$c>= :: Residue -> Residue -> Bool
> :: Residue -> Residue -> Bool
$c> :: Residue -> Residue -> Bool
<= :: Residue -> Residue -> Bool
$c<= :: Residue -> Residue -> Bool
< :: Residue -> Residue -> Bool
$c< :: Residue -> Residue -> Bool
compare :: Residue -> Residue -> Ordering
$ccompare :: Residue -> Residue -> Ordering
$cp1Ord :: Eq Residue
Ord,Int -> Residue -> [Char] -> [Char]
[Residue] -> [Char] -> [Char]
Residue -> [Char]
(Int -> Residue -> [Char] -> [Char])
-> (Residue -> [Char])
-> ([Residue] -> [Char] -> [Char])
-> Show Residue
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [Residue] -> [Char] -> [Char]
$cshowList :: [Residue] -> [Char] -> [Char]
show :: Residue -> [Char]
$cshow :: Residue -> [Char]
showsPrec :: Int -> Residue -> [Char] -> [Char]
$cshowsPrec :: Int -> Residue -> [Char] -> [Char]
Show)

multiplyResidue :: Residue -> Residue -> Residue
multiplyResidue :: Residue -> Residue -> Residue
multiplyResidue Residue
ZeroResidue Residue
_ = Residue
ZeroResidue
multiplyResidue Residue
_ Residue
ZeroResidue = Residue
ZeroResidue
multiplyResidue Residue
r1 Residue
r2 = if Residue
r1 Residue -> Residue -> Bool
forall a. Eq a => a -> a -> Bool
== Residue
r2 then Residue
Residue else Residue
NonResidue

jacobiSymbol :: Integer -> Integer -> Residue
jacobiSymbol :: Integer -> Integer -> Residue
jacobiSymbol =
    \Integer
m Integer
n -> if Integer
n Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
1 then Residue
Residue else Bool -> Integer -> Integer -> Residue
go Bool
False Integer
m Integer
n
  where
    go :: Bool -> Integer -> Integer -> Residue
go Bool
f Integer
m Integer
n =  -- Invariant: n is a positive odd integer greater than 1
        if Integer
p Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 then Residue
ZeroResidue
        else if Integer
s Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
1 then if Bool
g then Residue
NonResidue else Residue
Residue
        else Bool -> Integer -> Integer -> Residue
go Bool
h Integer
n Integer
s
      where
        p :: Integer
p = Integer
m Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
n
        (Integer
r,Integer
s) = Integer -> Integer -> (Integer, Integer)
divPower Integer
2 Integer
p
        n8 :: Integer
n8 = Integer
n Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
8
        n8_17 :: Bool
n8_17 = Integer
n8 Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
1 Bool -> Bool -> Bool
|| Integer
n8 Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
7
        n4_1 :: Bool
n4_1 = Integer
n8 Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
1 Bool -> Bool -> Bool
|| Integer
n8 Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
5
        s4_1 :: Bool
s4_1 = Integer
s Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
4 Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
1
        g :: Bool
g = if Integer -> Bool
forall a. Integral a => a -> Bool
even Integer
r Bool -> Bool -> Bool
|| Bool
n8_17 then Bool
f else Bool -> Bool
not Bool
f
        h :: Bool
h = if Bool
n4_1 Bool -> Bool -> Bool
|| Bool
s4_1 then Bool
g else Bool -> Bool
not Bool
g

-------------------------------------------------------------------------------
-- Making lists
-------------------------------------------------------------------------------

singleton :: a -> [a]
singleton :: a -> [a]
singleton a
x = [a
x]

doubleton :: a -> a -> [a]
doubleton :: a -> a -> [a]
doubleton a
x a
y = [a
x,a
y]

tripleton :: a -> a -> a -> [a]
tripleton :: a -> a -> a -> [a]
tripleton a
x a
y a
z = [a
x,a
y,a
z]

-------------------------------------------------------------------------------
-- Unfolding lists a fixed number of times
-------------------------------------------------------------------------------

unfoldlN :: (b -> (a,b)) -> Int -> b -> ([a],b)
unfoldlN :: (b -> (a, b)) -> Int -> b -> ([a], b)
unfoldlN b -> (a, b)
f = Int -> b -> ([a], b)
forall a. (Eq a, Num a) => a -> b -> ([a], b)
go
  where
    go :: a -> b -> ([a], b)
go a
0 b
s = ([],b
s)
    go a
n b
s = (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs, b
u)
      where
        (a
x,b
t) = b -> (a, b)
f b
s
        ([a]
xs,b
u) = a -> b -> ([a], b)
go (a
n a -> a -> a
forall a. Num a => a -> a -> a
- a
1) b
t

unfoldrN :: (b -> (a,b)) -> Int -> b -> ([a],b)
unfoldrN :: (b -> (a, b)) -> Int -> b -> ([a], b)
unfoldrN b -> (a, b)
f = [a] -> Int -> b -> ([a], b)
forall t. (Eq t, Num t) => [a] -> t -> b -> ([a], b)
go []
  where
    go :: [a] -> t -> b -> ([a], b)
go [a]
xs t
0 b
s = ([a]
xs,b
s)
    go [a]
xs t
n b
s = [a] -> t -> b -> ([a], b)
go (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs) (t
n t -> t -> t
forall a. Num a => a -> a -> a
- t
1) b
s' where (a
x,b
s') = b -> (a, b)
f b
s

-------------------------------------------------------------------------------
-- Abbreviated lists
-------------------------------------------------------------------------------

unabbrevList :: [String] -> String
unabbrevList :: [[Char]] -> [Char]
unabbrevList = ([Char] -> [Char]) -> [[Char]] -> [Char]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\[Char]
x -> [Char]
"\n  " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
x)

abbrevList :: String -> [String] -> String
abbrevList :: [Char] -> [[Char]] -> [Char]
abbrevList [Char]
s [[Char]]
l = [[Char]] -> [Char]
unabbrevList [[Char]]
m
  where
    i :: Int
i = Int
3
    m :: [[Char]]
m = Int -> [[Char]] -> [[Char]]
forall a. Int -> [a] -> [a]
take Int
i [[Char]]
l [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ (if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 then Int -> [[Char]] -> [[Char]]
forall a. Int -> [a] -> [a]
drop Int
i [[Char]]
l else [[Char]]
o [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++  Int -> [[Char]] -> [[Char]]
forall a. Int -> [a] -> [a]
drop (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i) [[Char]]
l)
    o :: [[Char]]
o = [[Char]
"[... " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
i) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" omitted " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
s [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" ...]"]
    n :: Int
n = [[Char]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Char]]
l

-------------------------------------------------------------------------------
-- Underlining
-------------------------------------------------------------------------------

underline :: String -> String
underline :: [Char] -> [Char]
underline [Char]
s = [Char]
s [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate ([Char] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
s) Char
'-'

-------------------------------------------------------------------------------
-- Pretty-print a table
-------------------------------------------------------------------------------

data Table =
    Table
      {Table -> Bool
borderTable :: Bool,
       Table -> Bool
alignLeftTable :: Bool,
       Table -> Int
paddingTable :: Int}
  deriving (Int -> Table -> [Char] -> [Char]
[Table] -> [Char] -> [Char]
Table -> [Char]
(Int -> Table -> [Char] -> [Char])
-> (Table -> [Char]) -> ([Table] -> [Char] -> [Char]) -> Show Table
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [Table] -> [Char] -> [Char]
$cshowList :: [Table] -> [Char] -> [Char]
show :: Table -> [Char]
$cshow :: Table -> [Char]
showsPrec :: Int -> Table -> [Char] -> [Char]
$cshowsPrec :: Int -> Table -> [Char] -> [Char]
Show)

fmtTable :: Table -> [[String]] -> String
fmtTable :: Table -> [[[Char]]] -> [Char]
fmtTable Table
fmt [[[Char]]]
table = ((Int, [(Int, [[Char]])]) -> [Char])
-> [(Int, [(Int, [[Char]])])] -> [Char]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int, [(Int, [[Char]])]) -> [Char]
ppRow [(Int, [(Int, [[Char]])])]
rows
  where
    rows :: [(Int,[(Int,[String])])]
    rows :: [(Int, [(Int, [[Char]])])]
rows = ([[Char]] -> (Int, [(Int, [[Char]])]))
-> [[[Char]]] -> [(Int, [(Int, [[Char]])])]
forall a b. (a -> b) -> [a] -> [b]
map [[Char]] -> (Int, [(Int, [[Char]])])
mkRow [[[Char]]]
table

    colWidths :: [Int]
    colWidths :: [Int]
colWidths = ((Int, [(Int, [[Char]])]) -> [Int] -> [Int])
-> [Int] -> [(Int, [(Int, [[Char]])])] -> [Int]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ([Int] -> [Int] -> [Int]
maxWidths ([Int] -> [Int] -> [Int])
-> ((Int, [(Int, [[Char]])]) -> [Int])
-> (Int, [(Int, [[Char]])])
-> [Int]
-> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, [[Char]]) -> Int) -> [(Int, [[Char]])] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, [[Char]]) -> Int
forall a b. (a, b) -> a
fst ([(Int, [[Char]])] -> [Int])
-> ((Int, [(Int, [[Char]])]) -> [(Int, [[Char]])])
-> (Int, [(Int, [[Char]])])
-> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, [(Int, [[Char]])]) -> [(Int, [[Char]])]
forall a b. (a, b) -> b
snd) [] [(Int, [(Int, [[Char]])])]
rows

    cols :: Int
    cols :: Int
cols = [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
colWidths

    mkRow :: [String] -> (Int,[(Int,[String])])
    mkRow :: [[Char]] -> (Int, [(Int, [[Char]])])
mkRow [] = (Int
0,[])
    mkRow [[Char]]
row = ([Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (((Int, [[Char]]) -> Int) -> [(Int, [[Char]])] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ([[Char]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([[Char]] -> Int)
-> ((Int, [[Char]]) -> [[Char]]) -> (Int, [[Char]]) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, [[Char]]) -> [[Char]]
forall a b. (a, b) -> b
snd) [(Int, [[Char]])]
ents), [(Int, [[Char]])]
ents)
      where ents :: [(Int, [[Char]])]
ents = ([Char] -> (Int, [[Char]])) -> [[Char]] -> [(Int, [[Char]])]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> (Int, [[Char]])
mkEntry [[Char]]
row

    mkEntry :: String -> (Int,[String])
    mkEntry :: [Char] -> (Int, [[Char]])
mkEntry [Char]
ent = case [Char] -> [[Char]]
lines [Char]
ent of
                    [] -> (Int
0,[])
                    [[Char]]
l -> ([Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (([Char] -> Int) -> [[Char]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Char]]
l), [[Char]]
l)

    ppRow :: (Int,[(Int,[String])]) -> String
    ppRow :: (Int, [(Int, [[Char]])]) -> [Char]
ppRow (Int
_,[]) = (if Bool
border then [Char]
hBorder else [Char]
"") [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\n"
    ppRow (Int
h,[(Int, [[Char]])]
ents) = [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Char]] -> [[Char]]
forall a. [a] -> [a]
reverse [[Char]]
ls)
      where
        row :: [(Int, [[Char]])]
row = [(Int, [[Char]])]
ents [(Int, [[Char]])] -> [(Int, [[Char]])] -> [(Int, [[Char]])]
forall a. [a] -> [a] -> [a]
++ Int -> (Int, [[Char]]) -> [(Int, [[Char]])]
forall a. Int -> a -> [a]
replicate (Int
cols Int -> Int -> Int
forall a. Num a => a -> a -> a
- [(Int, [[Char]])] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Int, [[Char]])]
ents) (Int
0,[])
        ([[Char]]
ls,[(Int, (Int, [[Char]]))]
_) = ([(Int, (Int, [[Char]]))] -> ([Char], [(Int, (Int, [[Char]]))]))
-> Int
-> [(Int, (Int, [[Char]]))]
-> ([[Char]], [(Int, (Int, [[Char]]))])
forall b a. (b -> (a, b)) -> Int -> b -> ([a], b)
unfoldrN [(Int, (Int, [[Char]]))] -> ([Char], [(Int, (Int, [[Char]]))])
peelRow Int
h ([Int] -> [(Int, [[Char]])] -> [(Int, (Int, [[Char]]))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
colWidths [(Int, [[Char]])]
row)

    peelRow :: [(Int,(Int,[String]))] -> (String, [(Int,(Int,[String]))])
    peelRow :: [(Int, (Int, [[Char]]))] -> ([Char], [(Int, (Int, [[Char]]))])
peelRow [(Int, (Int, [[Char]]))]
row = ([Char]
l,[(Int, (Int, [[Char]]))]
row')
      where
        (([Char]
s,Int
_),[(Int, (Int, [[Char]]))]
row') = (([Char], Int)
 -> (Int, (Int, [[Char]]))
 -> (([Char], Int), (Int, (Int, [[Char]]))))
-> ([Char], Int)
-> [(Int, (Int, [[Char]]))]
-> (([Char], Int), [(Int, (Int, [[Char]]))])
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
List.mapAccumL (([Char], Int)
-> (Int, (Int, [[Char]]))
-> (([Char], Int), (Int, (Int, [[Char]])))
peelEntry (([Char], Int)
 -> (Int, (Int, [[Char]]))
 -> (([Char], Int), (Int, (Int, [[Char]]))))
-> (([Char], Int) -> ([Char], Int))
-> ([Char], Int)
-> (Int, (Int, [[Char]]))
-> (([Char], Int), (Int, (Int, [[Char]])))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char], Int) -> ([Char], Int)
vBorder) ([Char]
"",Int
0) [(Int, (Int, [[Char]]))]
row
        l :: [Char]
l = (if Bool
border then [Char] -> [Char]
forall a. [a] -> [a]
tail [Char]
s else [Char]
s) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\n"

    peelEntry :: (String,Int) -> (Int,(Int,[String])) ->
                 ((String,Int),(Int,(Int,[String])))
    peelEntry :: ([Char], Int)
-> (Int, (Int, [[Char]]))
-> (([Char], Int), (Int, (Int, [[Char]])))
peelEntry ([Char]
s,Int
k) (Int
cw,(Int
ew,[])) = (([Char]
s, Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
cw Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
padding),(Int
cw,(Int
ew,[])))
    peelEntry ([Char]
s,Int
k) (Int
cw, (Int
ew, [Char]
x : [[Char]]
xs)) = (([Char], Int)
sk,(Int
cw,(Int
ew,[[Char]]
xs)))
      where
        sk :: ([Char], Int)
sk = if Bool
alignLeft then ([Char], Int)
skl else ([Char], Int)
skr
        skl :: ([Char], Int)
skl = ([Char]
s [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate Int
k Char
' ' [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
x, (Int
cw Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
padding) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
xw)
        skr :: ([Char], Int)
skr = ([Char]
s [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate ((Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
cw) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ew) Char
' ' [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
x, (Int
ew Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
padding) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
xw)
        xw :: Int
xw = [Char] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
x

    vBorder :: (String,Int) -> (String,Int)
    vBorder :: ([Char], Int) -> ([Char], Int)
vBorder ([Char]
s,Int
k) | Bool
border = ([Char]
s [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate Int
k Char
' ' [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"|", Int
padding)
    vBorder ([Char]
s,Int
k) | Bool
otherwise = ([Char]
s,Int
k)

    hBorder :: String
    hBorder :: [Char]
hBorder = [Char] -> [Char]
forall a. [a] -> [a]
tail ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ (Int -> [Char]) -> [Int] -> [Char]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Int -> [Char]
sep [Int]
colWidths
      where sep :: Int -> [Char]
sep Int
w = [Char]
"+" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
padding) Char
'-'

    border :: Bool
    border :: Bool
border = Table -> Bool
borderTable Table
fmt

    alignLeft :: Bool
    alignLeft :: Bool
alignLeft = Table -> Bool
alignLeftTable Table
fmt

    padding :: Int
    padding :: Int
padding = Table -> Int
paddingTable Table
fmt

    maxWidths :: [Int] -> [Int] -> [Int]
    maxWidths :: [Int] -> [Int] -> [Int]
maxWidths [Int]
r1 [Int]
r2 =
      (Int -> Int -> Int) -> [Int] -> [Int] -> [Int]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> Int -> Int
forall a. Ord a => a -> a -> a
max [Int]
r1 [Int]
r2 [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++
      (case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ([Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
r1) ([Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
r2) of
         Ordering
LT -> Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
drop ([Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
r1) [Int]
r2
         Ordering
EQ -> []
         Ordering
GT -> Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
drop ([Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
r2) [Int]
r1)

ppTable :: [[String]] -> String
ppTable :: [[[Char]]] -> [Char]
ppTable = Table -> [[[Char]]] -> [Char]
fmtTable (Bool -> Bool -> Int -> Table
Table Bool
True Bool
False Int
2)