{-# LANGUAGE NoMonomorphismRestriction, TypeSynonymInstances, FlexibleInstances #-}

module Parsing.Chart where

import Data.Array
import Data.Maybe
import Prelude ()
import Data.Traversable (sequenceA)
import Control.Applicative ((<$>),(<*>),pure)
import Control.Monad(join)

import Data.List (splitAt)
import Algebra.RingUtils
import qualified Data.Matrix.Quad as Q
import Data.Matrix.Class

fingerprint :: SomeTri a -> [[Char]]
fingerprint = SomeTri a -> [[Char]]
forall {a}. AbelianGroupZ a => SomeTri a -> [[Char]]
Q.fingerprint

{-
mkTreeHelp alt s = sweeps (map single s)
 where
  sweeps []  = error "can't parse the empty string, sorry"
  sweeps [p] = p
  sweeps ps  = sweeps (pairs ps alts)

  pairs []  _       = []
  pairs [p] _      = [p]
  pairs (p:q:ps) (b:bs) = (merging b p q) : pairs ps bs

  alts = cycle alt
  -}

-- mkTree2 :: (AbelianGroupZ (c a), RingP a, IsChart c) => Bool -> [Pair a] -> c a
mkTree2 :: RingP a => Bool -> [Pair a] -> Q.Q a
mkTree2 :: forall a. RingP a => Bool -> [Pair a] -> Q a
mkTree2 Bool
p [] = [Char] -> Q a
forall a. HasCallStack => [Char] -> a
error [Char]
"can't parse the empty string, sorry"
mkTree2 Bool
p [Pair a
x] = Pair a -> Q a
forall {a}. AbelianGroupZ a => Pair a -> SomeTri a
Q.square2 Pair a
x
mkTree2 Bool
p [Pair a
x,Pair a
y] = Bool -> Pair a -> Pair a -> Q a
forall {a}. RingP a => Bool -> Pair a -> Pair a -> SomeTri a
Q.square3 Bool
p Pair a
x Pair a
y
mkTree2 Bool
p [Pair a]
leaves = Bool -> Q a -> Pair a -> Q a -> Q a
forall a.
RingP a =>
Bool -> SomeTri a -> Pair a -> SomeTri a -> SomeTri a
Q.mergein Bool
p (Bool -> [Pair a] -> Q a
forall a. RingP a => Bool -> [Pair a] -> Q a
mkTree2 Bool
False [Pair a]
xs) Pair a
y (Bool -> [Pair a] -> Q a
forall a. RingP a => Bool -> [Pair a] -> Q a
mkTree2 Bool
True [Pair a]
zs)
 where ([Pair a]
xs,Pair a
y:[Pair a]
zs) = Int -> [Pair a] -> ([Pair a], [Pair a])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
n2 [Pair a]
leaves
       n2 :: Int
n2 = [Pair a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Pair a]
leaves Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2


-- mkTree :: (RingP a, IsChart c) => [Pair a] -> c a
mkTree :: [Pair a] -> Q a
mkTree = Bool -> [Pair a] -> Q a
forall a. RingP a => Bool -> [Pair a] -> Q a
mkTree2 Bool
False -- mkTreeHelp [False,True]
mkTree' :: [Pair a] -> Q a
mkTree' = Bool -> [Pair a] -> Q a
forall a. RingP a => Bool -> [Pair a] -> Q a
mkTree2 Bool
True -- mkTreeHelp [True,False]


type Set a = [a]

-- Sets form an abelian group
instance AbelianGroup (Set a) where
    zero :: Set a
zero = []
    + :: Set a -> Set a -> Set a
(+) = Set a -> Set a -> Set a
forall a. Set a -> Set a -> Set a
(++)

instance AbelianGroupZ (Set a) where
    isZero :: Set a -> Bool
isZero = Set a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null

type MT2 a = Q.Q a

genXPM :: [[Char]] -> [Char]
genXPM xs :: [[Char]]
xs@([Char]
h:[[Char]]
_) = [[Char]] -> [Char]
unlines ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$
  [[Char]
"! XPM2",
   -- <width/cols> <height/rows> <colors> <char on pixel>
   Int -> [Char]
forall a. Show a => a -> [Char]
show Int
width [Char] -> [Char] -> [Char]
forall a. Set a -> Set a -> Set a
++ [Char]
" " [Char] -> [Char] -> [Char]
forall a. Set a -> Set a -> Set a
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
height [Char] -> [Char] -> [Char]
forall a. Set a -> Set a -> Set a
++ [Char]
" 4 1",
   [Char]
"X c cyan",
   [Char]
"< c blue",
   [Char]
"> c red",
   [Char]
"  c black"
   ] [[Char]] -> [[Char]] -> [[Char]]
forall a. Set a -> Set a -> Set a
++
   [[Char]]
xs
  where width :: Int
width = [Char] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
h
        height :: Int
height = [[Char]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Char]]
xs

root :: SomeTri p -> p
root = SomeTri p -> p
forall {p}. AbelianGroup p => SomeTri p -> p
Q.root
mergein :: Bool -> SomeTri a -> Pair a -> SomeTri a -> SomeTri a
mergein Bool
a SomeTri a
c Pair a
b = Bool -> SomeTri a -> Pair a -> SomeTri a -> SomeTri a
forall a.
RingP a =>
Bool -> SomeTri a -> Pair a -> SomeTri a -> SomeTri a
Q.mergein Bool
a SomeTri a
c Pair a
b
single :: Pair a -> SomeTri a
single Pair a
x = Pair a -> SomeTri a
forall {a}. AbelianGroupZ a => Pair a -> SomeTri a
Q.single Pair a
x