-- For GHC version 7.10 or higher

{-# LANGUAGE GADTs, KindSignatures, DataKinds #-}
{-# LANGUAGE LambdaCase #-}

{-# OPTIONS_GHC -fno-warn-unused-binds #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}
{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}
{-# OPTIONS_GHC -fno-warn-overlapping-patterns #-}

module AbsFstStudio ( Tree(..)
, Program
, Def
, Exp
, Ident
, johnMajorEq
, module ComposOpFstStudio ) where

import Prelude ((.), (>), (&&), (==))
import Prelude ((.), (>), (&&), (==))
import qualified Prelude as P

import ComposOpFstStudio

data Tag = Program_ | Def_ | Exp_ | Ident_
type Program = Tree 'Program_
type Def = Tree 'Def_
type Exp = Tree 'Exp_
type Ident = Tree 'Ident_

data Tree (a :: Tag) where
  Prog :: [Def] -> Tree 'Program_
  Declaration :: Ident -> [Ident] -> Exp -> Tree 'Def_
  Import :: [Ident] -> Tree 'Def_
  Main :: Exp -> Tree 'Def_
  Any :: Tree 'Exp_
  AppDecl :: Ident -> [Exp] -> Tree 'Exp_
  Boundary :: Tree 'Exp_
  CReplacement :: Exp -> Exp -> Exp -> Exp -> Tree 'Exp_
  CSReplacement :: Exp -> Exp -> Exp -> Exp -> Tree 'Exp_
  Complement :: Exp -> Tree 'Exp_
  Composition :: Exp -> Exp -> Tree 'Exp_
  Concat :: Exp -> Exp -> Tree 'Exp_
  Concats :: P.String -> Tree 'Exp_
  Containment :: Exp -> Tree 'Exp_
  CrossProduct :: Exp -> Exp -> Tree 'Exp_
  Epsilon :: Tree 'Exp_
  Intersect :: Exp -> Exp -> Tree 'Exp_
  LongReplace :: Exp -> Exp -> Tree 'Exp_
  Markup :: Exp -> Exp -> Tree 'Exp_
  Minus :: Exp -> Exp -> Tree 'Exp_
  NConcat :: Exp -> P.Integer -> Tree 'Exp_
  Plus :: Exp -> Tree 'Exp_
  Relation :: P.String -> P.String -> Tree 'Exp_
  Replacement :: Exp -> Exp -> Tree 'Exp_
  Restriction :: Exp -> Exp -> Exp -> Tree 'Exp_
  Star :: Exp -> Tree 'Exp_
  Symbol :: P.String -> Tree 'Exp_
  TComplement :: Exp -> Tree 'Exp_
  Union :: Exp -> Exp -> Tree 'Exp_
  Variable :: Ident -> Tree 'Exp_
  Ident ::P.String -> Tree 'Ident_

instance Compos Tree where
  compos r a f = \case
    Prog defs -> r Prog `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) defs
    Declaration x idents exp -> r Declaration `a` f x `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) idents `a` f exp
    Import idents -> r Import `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) idents
    Main exp -> r Main `a` f exp
    AppDecl x exps -> r AppDecl `a` f x `a` P.foldr (\ x z -> r (:) `a` f x `a` z) (r []) exps
    CReplacement exp1 exp2 exp3 exp4 -> r CReplacement `a` f exp1 `a` f exp2 `a` f exp3 `a` f exp4
    CSReplacement exp1 exp2 exp3 exp4 -> r CSReplacement `a` f exp1 `a` f exp2 `a` f exp3 `a` f exp4
    Complement exp -> r Complement `a` f exp
    Composition exp1 exp2 -> r Composition `a` f exp1 `a` f exp2
    Concat exp1 exp2 -> r Concat `a` f exp1 `a` f exp2
    Containment exp -> r Containment `a` f exp
    CrossProduct exp1 exp2 -> r CrossProduct `a` f exp1 `a` f exp2
    Intersect exp1 exp2 -> r Intersect `a` f exp1 `a` f exp2
    LongReplace exp1 exp2 -> r LongReplace `a` f exp1 `a` f exp2
    Markup exp1 exp2 -> r Markup `a` f exp1 `a` f exp2
    Minus exp1 exp2 -> r Minus `a` f exp1 `a` f exp2
    NConcat exp n -> r NConcat `a` f exp `a` r n
    Plus exp -> r Plus `a` f exp
    Replacement exp1 exp2 -> r Replacement `a` f exp1 `a` f exp2
    Restriction exp1 exp2 exp3 -> r Restriction `a` f exp1 `a` f exp2 `a` f exp3
    Star exp -> r Star `a` f exp
    TComplement exp -> r TComplement `a` f exp
    Union exp1 exp2 -> r Union `a` f exp1 `a` f exp2
    Variable x -> r Variable `a` f x
    t -> r t

instance P.Show (Tree c) where
  showsPrec n = \case
    Ident str -> opar . P.showString "Ident" . P.showChar ' ' . P.showsPrec 1 str . cpar
    Prog defs -> opar . P.showString "Prog" . P.showChar ' ' . P.showsPrec 1 defs . cpar
    Declaration x idents exp -> opar . P.showString "Declaration" . P.showChar ' ' . P.showsPrec 1 x . P.showChar ' ' . P.showsPrec 1 idents . P.showChar ' ' . P.showsPrec 1 exp . cpar
    Import idents -> opar . P.showString "Import" . P.showChar ' ' . P.showsPrec 1 idents . cpar
    Main exp -> opar . P.showString "Main" . P.showChar ' ' . P.showsPrec 1 exp . cpar
    Any -> P.showString "Any"
    AppDecl x exps -> opar . P.showString "AppDecl" . P.showChar ' ' . P.showsPrec 1 x . P.showChar ' ' . P.showsPrec 1 exps . cpar
    Boundary -> P.showString "Boundary"
    CReplacement exp1 exp2 exp3 exp4 -> opar . P.showString "CReplacement" . P.showChar ' ' . P.showsPrec 1 exp1 . P.showChar ' ' . P.showsPrec 1 exp2 . P.showChar ' ' . P.showsPrec 1 exp3 . P.showChar ' ' . P.showsPrec 1 exp4 . cpar
    CSReplacement exp1 exp2 exp3 exp4 -> opar . P.showString "CSReplacement" . P.showChar ' ' . P.showsPrec 1 exp1 . P.showChar ' ' . P.showsPrec 1 exp2 . P.showChar ' ' . P.showsPrec 1 exp3 . P.showChar ' ' . P.showsPrec 1 exp4 . cpar
    Complement exp -> opar . P.showString "Complement" . P.showChar ' ' . P.showsPrec 1 exp . cpar
    Composition exp1 exp2 -> opar . P.showString "Composition" . P.showChar ' ' . P.showsPrec 1 exp1 . P.showChar ' ' . P.showsPrec 1 exp2 . cpar
    Concat exp1 exp2 -> opar . P.showString "Concat" . P.showChar ' ' . P.showsPrec 1 exp1 . P.showChar ' ' . P.showsPrec 1 exp2 . cpar
    Concats str -> opar . P.showString "Concats" . P.showChar ' ' . P.showsPrec 1 str . cpar
    Containment exp -> opar . P.showString "Containment" . P.showChar ' ' . P.showsPrec 1 exp . cpar
    CrossProduct exp1 exp2 -> opar . P.showString "CrossProduct" . P.showChar ' ' . P.showsPrec 1 exp1 . P.showChar ' ' . P.showsPrec 1 exp2 . cpar
    Epsilon -> P.showString "Epsilon"
    Intersect exp1 exp2 -> opar . P.showString "Intersect" . P.showChar ' ' . P.showsPrec 1 exp1 . P.showChar ' ' . P.showsPrec 1 exp2 . cpar
    LongReplace exp1 exp2 -> opar . P.showString "LongReplace" . P.showChar ' ' . P.showsPrec 1 exp1 . P.showChar ' ' . P.showsPrec 1 exp2 . cpar
    Markup exp1 exp2 -> opar . P.showString "Markup" . P.showChar ' ' . P.showsPrec 1 exp1 . P.showChar ' ' . P.showsPrec 1 exp2 . cpar
    Minus exp1 exp2 -> opar . P.showString "Minus" . P.showChar ' ' . P.showsPrec 1 exp1 . P.showChar ' ' . P.showsPrec 1 exp2 . cpar
    NConcat exp n -> opar . P.showString "NConcat" . P.showChar ' ' . P.showsPrec 1 exp . P.showChar ' ' . P.showsPrec 1 n . cpar
    Plus exp -> opar . P.showString "Plus" . P.showChar ' ' . P.showsPrec 1 exp . cpar
    Relation str1 str2 -> opar . P.showString "Relation" . P.showChar ' ' . P.showsPrec 1 str1 . P.showChar ' ' . P.showsPrec 1 str2 . cpar
    Replacement exp1 exp2 -> opar . P.showString "Replacement" . P.showChar ' ' . P.showsPrec 1 exp1 . P.showChar ' ' . P.showsPrec 1 exp2 . cpar
    Restriction exp1 exp2 exp3 -> opar . P.showString "Restriction" . P.showChar ' ' . P.showsPrec 1 exp1 . P.showChar ' ' . P.showsPrec 1 exp2 . P.showChar ' ' . P.showsPrec 1 exp3 . cpar
    Star exp -> opar . P.showString "Star" . P.showChar ' ' . P.showsPrec 1 exp . cpar
    Symbol str -> opar . P.showString "Symbol" . P.showChar ' ' . P.showsPrec 1 str . cpar
    TComplement exp -> opar . P.showString "TComplement" . P.showChar ' ' . P.showsPrec 1 exp . cpar
    Union exp1 exp2 -> opar . P.showString "Union" . P.showChar ' ' . P.showsPrec 1 exp1 . P.showChar ' ' . P.showsPrec 1 exp2 . cpar
    Variable x -> opar . P.showString "Variable" . P.showChar ' ' . P.showsPrec 1 x . cpar
    where
    opar = if n > 0 then P.showChar '(' else P.id
    cpar = if n > 0 then P.showChar ')' else P.id

instance P.Eq (Tree c) where (==) = johnMajorEq

instance P.Ord (Tree c) where compare x y = P.compare (index x) (index y) `P.mappend` compareSame x y

index :: Tree c -> P.Int
index (Prog _) = 1
index (Declaration _ _ _) = 2
index (Import _) = 3
index (Main _) = 4
index (Any ) = 5
index (AppDecl _ _) = 6
index (Boundary ) = 7
index (CReplacement _ _ _ _) = 8
index (CSReplacement _ _ _ _) = 9
index (Complement _) = 10
index (Composition _ _) = 11
index (Concat _ _) = 12
index (Concats _) = 13
index (Containment _) = 14
index (CrossProduct _ _) = 15
index (Epsilon ) = 16
index (Intersect _ _) = 17
index (LongReplace _ _) = 18
index (Markup _ _) = 19
index (Minus _ _) = 20
index (NConcat _ _) = 21
index (Plus _) = 22
index (Relation _ _) = 23
index (Replacement _ _) = 24
index (Restriction _ _ _) = 25
index (Star _) = 26
index (Symbol _) = 27
index (TComplement _) = 28
index (Union _ _) = 29
index (Variable _) = 30
index (Ident _) = 31

johnMajorEq :: Tree a -> Tree b -> P.Bool
johnMajorEq (Prog defs) (Prog defs_) = defs == defs_
johnMajorEq (Declaration x idents exp) (Declaration x_ idents_ exp_) = x == x_ && idents == idents_ && exp == exp_
johnMajorEq (Import idents) (Import idents_) = idents == idents_
johnMajorEq (Main exp) (Main exp_) = exp == exp_
johnMajorEq Any Any = P.True
johnMajorEq (AppDecl x exps) (AppDecl x_ exps_) = x == x_ && exps == exps_
johnMajorEq Boundary Boundary = P.True
johnMajorEq (CReplacement exp1 exp2 exp3 exp4) (CReplacement exp1_ exp2_ exp3_ exp4_) = exp1 == exp1_ && exp2 == exp2_ && exp3 == exp3_ && exp4 == exp4_
johnMajorEq (CSReplacement exp1 exp2 exp3 exp4) (CSReplacement exp1_ exp2_ exp3_ exp4_) = exp1 == exp1_ && exp2 == exp2_ && exp3 == exp3_ && exp4 == exp4_
johnMajorEq (Complement exp) (Complement exp_) = exp == exp_
johnMajorEq (Composition exp1 exp2) (Composition exp1_ exp2_) = exp1 == exp1_ && exp2 == exp2_
johnMajorEq (Concat exp1 exp2) (Concat exp1_ exp2_) = exp1 == exp1_ && exp2 == exp2_
johnMajorEq (Concats str) (Concats str_) = str == str_
johnMajorEq (Containment exp) (Containment exp_) = exp == exp_
johnMajorEq (CrossProduct exp1 exp2) (CrossProduct exp1_ exp2_) = exp1 == exp1_ && exp2 == exp2_
johnMajorEq Epsilon Epsilon = P.True
johnMajorEq (Intersect exp1 exp2) (Intersect exp1_ exp2_) = exp1 == exp1_ && exp2 == exp2_
johnMajorEq (LongReplace exp1 exp2) (LongReplace exp1_ exp2_) = exp1 == exp1_ && exp2 == exp2_
johnMajorEq (Markup exp1 exp2) (Markup exp1_ exp2_) = exp1 == exp1_ && exp2 == exp2_
johnMajorEq (Minus exp1 exp2) (Minus exp1_ exp2_) = exp1 == exp1_ && exp2 == exp2_
johnMajorEq (NConcat exp n) (NConcat exp_ n_) = exp == exp_ && n == n_
johnMajorEq (Plus exp) (Plus exp_) = exp == exp_
johnMajorEq (Relation str1 str2) (Relation str1_ str2_) = str1 == str1_ && str2 == str2_
johnMajorEq (Replacement exp1 exp2) (Replacement exp1_ exp2_) = exp1 == exp1_ && exp2 == exp2_
johnMajorEq (Restriction exp1 exp2 exp3) (Restriction exp1_ exp2_ exp3_) = exp1 == exp1_ && exp2 == exp2_ && exp3 == exp3_
johnMajorEq (Star exp) (Star exp_) = exp == exp_
johnMajorEq (Symbol str) (Symbol str_) = str == str_
johnMajorEq (TComplement exp) (TComplement exp_) = exp == exp_
johnMajorEq (Union exp1 exp2) (Union exp1_ exp2_) = exp1 == exp1_ && exp2 == exp2_
johnMajorEq (Variable x) (Variable x_) = x == x_
johnMajorEq (Ident str) (Ident str_) = str == str_
johnMajorEq _ _ = P.False

compareSame :: Tree c -> Tree c -> P.Ordering
compareSame (Prog defs) (Prog defs_) = P.compare defs defs_
compareSame (Declaration x idents exp) (Declaration x_ idents_ exp_) = P.mappend (P.compare x x_) (P.mappend (P.compare idents idents_) (P.compare exp exp_))
compareSame (Import idents) (Import idents_) = P.compare idents idents_
compareSame (Main exp) (Main exp_) = P.compare exp exp_
compareSame Any Any = P.EQ
compareSame (AppDecl x exps) (AppDecl x_ exps_) = P.mappend (P.compare x x_) (P.compare exps exps_)
compareSame Boundary Boundary = P.EQ
compareSame (CReplacement exp1 exp2 exp3 exp4) (CReplacement exp1_ exp2_ exp3_ exp4_) = P.mappend (P.compare exp1 exp1_) (P.mappend (P.compare exp2 exp2_) (P.mappend (P.compare exp3 exp3_) (P.compare exp4 exp4_)))
compareSame (CSReplacement exp1 exp2 exp3 exp4) (CSReplacement exp1_ exp2_ exp3_ exp4_) = P.mappend (P.compare exp1 exp1_) (P.mappend (P.compare exp2 exp2_) (P.mappend (P.compare exp3 exp3_) (P.compare exp4 exp4_)))
compareSame (Complement exp) (Complement exp_) = P.compare exp exp_
compareSame (Composition exp1 exp2) (Composition exp1_ exp2_) = P.mappend (P.compare exp1 exp1_) (P.compare exp2 exp2_)
compareSame (Concat exp1 exp2) (Concat exp1_ exp2_) = P.mappend (P.compare exp1 exp1_) (P.compare exp2 exp2_)
compareSame (Concats str) (Concats str_) = P.compare str str_
compareSame (Containment exp) (Containment exp_) = P.compare exp exp_
compareSame (CrossProduct exp1 exp2) (CrossProduct exp1_ exp2_) = P.mappend (P.compare exp1 exp1_) (P.compare exp2 exp2_)
compareSame Epsilon Epsilon = P.EQ
compareSame (Intersect exp1 exp2) (Intersect exp1_ exp2_) = P.mappend (P.compare exp1 exp1_) (P.compare exp2 exp2_)
compareSame (LongReplace exp1 exp2) (LongReplace exp1_ exp2_) = P.mappend (P.compare exp1 exp1_) (P.compare exp2 exp2_)
compareSame (Markup exp1 exp2) (Markup exp1_ exp2_) = P.mappend (P.compare exp1 exp1_) (P.compare exp2 exp2_)
compareSame (Minus exp1 exp2) (Minus exp1_ exp2_) = P.mappend (P.compare exp1 exp1_) (P.compare exp2 exp2_)
compareSame (NConcat exp n) (NConcat exp_ n_) = P.mappend (P.compare exp exp_) (P.compare n n_)
compareSame (Plus exp) (Plus exp_) = P.compare exp exp_
compareSame (Relation str1 str2) (Relation str1_ str2_) = P.mappend (P.compare str1 str1_) (P.compare str2 str2_)
compareSame (Replacement exp1 exp2) (Replacement exp1_ exp2_) = P.mappend (P.compare exp1 exp1_) (P.compare exp2 exp2_)
compareSame (Restriction exp1 exp2 exp3) (Restriction exp1_ exp2_ exp3_) = P.mappend (P.compare exp1 exp1_) (P.mappend (P.compare exp2 exp2_) (P.compare exp3 exp3_))
compareSame (Star exp) (Star exp_) = P.compare exp exp_
compareSame (Symbol str) (Symbol str_) = P.compare str str_
compareSame (TComplement exp) (TComplement exp_) = P.compare exp exp_
compareSame (Union exp1 exp2) (Union exp1_ exp2_) = P.mappend (P.compare exp1 exp1_) (P.compare exp2 exp2_)
compareSame (Variable x) (Variable x_) = P.compare x x_
compareSame (Ident str) (Ident str_) = P.compare str str_
compareSame _ _ = P.error "BNFC error: compareSame"