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

  Generic interface for Term types.
-}
{-# LANGUAGE TemplateHaskell #-}
module Gen where

import GHC.Generics (Generic)

import Data.Binary               (Binary, decodeFile)
import Data.Default              (Default, def)
import Data.Text.Prettyprint.Doc (Doc)

import Lens.Micro.TH (makeLenses)

import qualified Graphics.Vty as V

-- | Syntactic annotations used for highlighting.
-- This should be stored in the pretty-printed code output,
-- in addition to term contexts.
data Syntax
  = Type
  -- ^ type information
  | Keyword
  -- ^ standard keywords of the language
  | Literal
  -- ^ literal values (e.g. strings, numbers)
  | Unique
  -- ^ unique identifiers
  | Qualifier
  -- ^ qualifiers for modules
  | Custom String
  -- ^ used for user-supplied styling

instance Show Syntax where
  show = \case
    Type      -> "type"
    Keyword   -> "keyword"
    Literal   -> "literal"
    Unique    -> "unique"
    Qualifier -> "qualifier"
    Custom s  -> s

-- | This is the typeclass that the user-supplied @term@ type should implement.
-- It requires all operations, which are necessary for our TUI to runn.
class Eq (Ctx term) => Diff term where
  -- | The type of annotations associated to the given @term@ type.
  type Ann     term :: *
  -- | The type of options for the associated pretty-printer for @term@.
  type Options term :: *
  -- | The type of navigation contexts for values of type @term@.
  type Ctx     term :: *

  -- | Read a rewrite history from a binBooary file on disk.
  readHistory :: FilePath -> IO (History term (Ctx term))

  default readHistory :: (Binary term, Binary (Ctx term))
                      => FilePath -> IO (History term (Ctx term))
  readHistory = decodeFile

  -- | Given a rewrite history, extract the top-level initial expression.
  initialExpr :: History term (Ctx term) -> term
  initialExpr = _before . last

  -- | If a binder containing this name exists, display first in the list of binders.
  topEntity :: String
  topEntity = "top"

  -- | Handle annotations of the pretty-printed code,
  -- emitting either syntax elements or navigation contexts.
  handleAnn :: Ann term -> Either Syntax (Ctx term)

  default handleAnn :: Ann term ~ Ctx term => Ann term -> Either Syntax (Ctx term)
  handleAnn = Right

  -- | User-supplied styling for the TUI.
  userStyles :: [(String, V.Attr)]
  userStyles = []

  -- | Initial options for the pretty-printer.
  initOptions :: Options term

  default initOptions :: Default (Options term) => Options term
  initOptions = def

  -- | Provide the boolean flags of the pretty-printing options.
  -- NB: Lenses are not used here, due to impredicativity...
  flagFields :: [( Options term -> Bool                  -- getter
                 , Options term -> Bool -> Options term  -- setter
                 , String                                -- text to display
                 )]
  flagFields = []

  -- | Pretty-print a given expression, given some options.
  -- The resulting document format should contain syntax/context annotations.
  ppr' :: Options term -> term -> Doc (Ann term)

  -- | Patch a given expression, given a navigation context to a sub-expression
  -- and a new sub-expression to replace it.
  patch :: term -> [Ctx term] -> term -> term

-- * Rewrite history.

-- | The rewrite history consists of multiple single steps of rewriting.
type History term ctx = [HStep term ctx]

-- | Each step of the rewrite history contains information about a single rewrite.
data HStep term ctx = HStep
  { _ctx    :: [ctx]
  -- ^ the current context of the sub-expression being rewritten
  , _bndrS  :: String
  -- ^ the name of the current binder
  , _name   :: String
  -- ^ the name of the applied transformation
  , _before :: term
  -- ^ the sub-expression __before__ rewriting
  , _after  :: term
  -- ^ the sub-expression __after__ rewriting
  } deriving (Generic, Show, Binary)
makeLenses ''HStep