{-|
  Copyright   :  (C) 2019, QBayLogic
  License     :  BSD2 (see the file LICENSE)
  Maintainer  :  Orestis Melkonian <melkon.or@gmail.com>
-}
{-# LANGUAGE OverloadedStrings, TypeApplications, TypeFamilies #-}

{-# OPTIONS_GHC -fno-warn-orphans       #-}
{-# OPTIONS_GHC -fno-warn-type-defaults #-}

module Main (main) where

import GHC.Generics (Generic)
import Data.Text.Prettyprint.Doc (annotate, hsep, pretty)

import Gen
import BrickUI (runTerminal)

main :: IO ()
main = runTerminal @Expr "examples/expr/theme.ini"

-------------------------------
-- Adhoc instance for Diff.

data Expr = N Int | Expr :+: Expr deriving (Eq, Show)

data ExprContext = L | R deriving (Eq, Show)

instance Diff Expr where
  type Ann     Expr = ExprContext
  type Options Expr = ()
  type Ctx     Expr = ExprContext

  readHistory _ = return [ HStep { _ctx    = [L]
                                 , _bndrS  = "top"
                                 , _name   = "adhocI"
                                 , _before = N 1
                                 , _after  = N 11 :+: N 12
                                 }
                         , HStep { _ctx    = [L, L]
                                 , _bndrS  = "top"
                                 , _name   = "adhocII"
                                 , _before = N 11
                                 , _after  = N 111 :+: N 112
                                 }
                         , HStep { _ctx    = []
                                 , _bndrS  = "top"
                                 , _name   = "normalization"
                                 , _before = N 1 :+: (N 2 :+: N 3)
                                 , _after  = ((N 111 :+: N 112) :+: N 12)
                                         :+: (N 2 :+: N 3)
                                 }
                         ]

  ppr' _    (N n)      = pretty n
  ppr' opts (e :+: e') = hsep [ annotate L (ppr' opts e)
                              , "+"
                              , annotate R (ppr' opts e')
                              ]

  patch _ []     e' = e'
  patch curE (c:cs) e' = let go e = patch e cs e' in
    case (curE, c) of
      (l :+: r, L) -> go l :+: r
      (l :+: r, R) -> l :+: go r
      _            -> error "patch"