{-# LANGUAGE FlexibleInstances  #-}
{-# LANGUAGE FlexibleContexts   #-}
{-# LANGUAGE TypeFamilies       #-}
{-# LANGUAGE TemplateHaskell    #-}
{-# LANGUAGE TypeOperators      #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE EmptyDataDecls     #-}
{-# LANGUAGE PatternSynonyms    #-}

module Regular where

import Datatypes
import Generics.Regular hiding (right)
import Generics.Regular.Transformations.Main
import Generics.Regular.Zipper

import Control.Monad ( (>=>) )
import Data.Maybe (fromJust)

--------------------------------------------------------------------------------
-- Regular representations for the example datatypes
--------------------------------------------------------------------------------
--Trees
$(deriveAll ''Tree "PFTree")
type instance PF Tree = PFTree

-- Lists
$(deriveAll ''List "PFL")
type instance PF (List a) = PFL a

-- Something more exotic
$(deriveAll ''X "PFX")
type instance PF X = PFX

-- Example for paper
$(deriveAll ''AExpr "PFExpr")
type instance PF Expr = PFExpr

deriving instance Ord AExpr

-- Datatype patterns
pattern Var'   x = In (InR (L (C (K x))))
pattern Const' x = In (InR (R (L (C (K x)))))
pattern Neg'   x = In (InR (R (R (L (C (I x))))))
pattern Add' x y = In (InR (R (R (R (C (I x :*: I y))))))

pattern Ref' x  = In (Ref x)

-- Path patterns
pattern End     = []
pattern Neg_0 x = CR (CR (CL (CC CId))) : x
pattern Add_0 x = CR (CR (CR (CC (C1 CId (I ()))))) : x
pattern Add_1 x = CR (CR (CR (CC (C2 (I ()) CId)))) : x

{-
type instance PF Expr = K String :+: K Integer :+: I :+: I :*: I

instance Regular Expr where
  from  (Var s)       = L (K s)
  from  (Const i)     = R (L (K i))
  from  (Neg e)       = R (R (L (I e)))
  from  (Add e1 e2)   = R (R (R (I e1 :*: I e2)))

  to (L (K s))                    = Var s
  to (R (L (K i)))                = Const i
  to (R (R (L (I e))))            = Neg e
  to (R (R (R (I e1 :*: I e2))))  = Add e1 e2
-}

--------------------------------------------------------------------------------
-- Examples for the paper
--------------------------------------------------------------------------------
instance Transform Expr

-- Some example values
expr1 :: Expr
expr1 = Add (Const 1) (Var "a")

expr2 :: Expr
expr2 = Add (Const 1) (Neg (Var "a"))

expr3 :: Expr
expr3 = Add (Var "a") (Const 1)

explicitIns :: Maybe Expr
explicitIns = apply addNeg expr1
  where addNeg :: Transformation Expr
        addNeg = diff expr1 expr2

-- Testing the nicer notation for paths and expressions with references
test1 :: Fix (WithRef Expr)
test1 = Neg' (Ref' test2)

test2 :: Path Expr
test2 = Add_1 End

test3 :: Transformation Expr
test3 = [(test2, test1)]

test4 :: Bool
test4 = show test3 == show (diff expr1 expr2)

-- Deletion (expr2 => expr1)
explicitDel :: Maybe Expr
explicitDel = apply delNeg expr2
  where delNeg :: Transformation Expr
        delNeg = diff expr2 expr1 --[ ([1], In (Ref [1,0])) ]

-- Swapping (expr1 => expr3)
explicitSwap :: Maybe Expr
explicitSwap = apply swap' expr1
  where swap' :: Transformation Expr
        swap' = diff expr1 expr3 -- [ ([0], In $ Ref [1]), ([1], In $ Ref [0])]

-- Rotation
rotate1 = Add (Var "a") (Add (Var "b") (Var "c"))
rotate2 = Add (Add (Var "a") (Var "b")) (Var "c")
rotate = diff rotate1 rotate2