{-# LANGUAGE UnicodeSyntax, MultiParamTypeClasses, PatternGuards, FlexibleInstances, TypeSynonymInstances, OverlappingInstances, ViewPatterns, FlexibleContexts #-}

module Editing.Commands where

import qualified Cxx.Basics
import qualified Request
import qualified Data.List as List
import qualified Data.Char as Char
import Data.Function (on)
import Data.Foldable (toList)
import Editing.Basics (Pos(pos), Anchor(..), Side(..), StickyRange, Range(..), unanchor_range)
import Cxx.Basics (DeclaratorId, Findable)

import Data.Monoid (Monoid(..))
import Util (Convert(..), Invertible(..), Ordinal(..), (.), findMaybe, take_atleast, isIdChar, NeList, neElim)
import Data.Semigroup (Semigroup(..))

import Prelude hiding ((.))

data DualStickyRange = DualStickyRange { full_range, replace_range :: StickyRange Char }
  -- In "void f(int i, double d);", the command "replace first parameter-declaration with char c" should produce "void f(char c, double d);", while the command "erase first parameter-declaration" should produce "void f(double d);". Hence, in the former, the clause "first parameter-declaration" should match "char c", while in the latter, it should match "char c, ". To accomodate this, our substring resolution functions return DualStickyRanges containing both of these ranges.

-- AndLists

newtype AndList a = AndList { andList :: NeList a }

instance Functor AndList where fmap f (AndList l) = AndList (fmap f l)

and_one :: a → AndList a
and_one = AndList . return

instance Semigroup (AndList a) where
  AndList x <> AndList y = AndList $ x <> y

-- Command grammar

data EverythingOr a = Everything | NotEverything a
data Ranked a = Ranked Ordinal a | Sole a
newtype OccurrencesClause = OccurrencesClause (NeList Ordinal)
data Rankeds a = Rankeds (AndList OccurrencesClause) a | Sole' a | All a | AllBut (AndList OccurrencesClause) a
data Bound = Bound (Maybe Side) Substr
data RelativeBound = Front | Back | RelativeBound (Maybe Side) (Relative Substr)
data Relative a = Absolute a | Relative a (AndList Side) (Ranked (Either Findable String)) | Between a Betw | FromTill Bound RelativeBound
  -- FromTill is not the same as (Between Everything), because in the former, the second bound is interpreted relative to the first, whereas in the latter, both bounds are absolute.
  -- Strictly speaking, Absolute can be (and was at some point) encoded by (Between blabla). However, it isn't worth the trouble of the necessary special cases in Show, Parse, etc.
data In a = In a (Maybe InClause)
data PositionsClause = PositionsClause (AndList Side) Substrs
data InClause = InClause (AndList (In (Relative (Rankeds (Either Findable ImplicitBodyOf)))))
data AppendPositionsClause = AppendIn InClause | NonAppendPositionsClause PositionsClause
data PrependPositionsClause = PrependIn InClause | NonPrependPositionsClause PositionsClause
type Substr = EverythingOr (Ranked (Either Findable String))
newtype Substrs = Substrs (AndList (In (Relative (EverythingOr (Rankeds (Either Findable String))))))
newtype MakeSubject = MakeSubject (AndList (In (Relative (Rankeds (Either Findable ImplicitDeclarationOf)))))
data Position = Position Side (In (Relative Substr))
data Replacer = Replacer Substrs String | ReplaceOptions [Request.EvalOpt] [Request.EvalOpt]
data Changer = Changer Substrs String | ChangeOptions [Request.EvalOpt] [Request.EvalOpt]
data Eraser = EraseText Substrs | EraseOptions [Request.EvalOpt] | EraseAround Wrapping (Around Substrs)
data Mover = Mover Substrs Position
data Around a = Around a
data Betw = Betw Bound RelativeBound
data Wrapping = Wrapping String String
data UsePattern = UsePattern String
data UseClause = UseString (In (Relative UsePattern)) | UseOptions [Request.EvalOpt]
newtype ImplicitDeclarationOf = ImplicitDeclarationOf DeclaratorId
newtype ImplicitBodyOf = ImplicitBodyOf DeclaratorId
data Insertee = SimpleInsert String | WrapInsert Wrapping

data Command
  = Insert Insertee (AndList AppendPositionsClause)
  | Append String (Maybe (AndList AppendPositionsClause))
  | Prepend String (Maybe (AndList PrependPositionsClause))
  | Replace (AndList Replacer)
  | Change (AndList Changer)
  | Erase (AndList Eraser)
  | Move (AndList Mover)
  | Swap Substrs (Maybe Substrs)
  | Make MakeSubject Cxx.Basics.MakeDeclaration
  | Use (AndList UseClause)
  | Fix

data FinalCommand
  = Show (Maybe Substrs)
  | Identify Substrs
  | Parse
  | Diff
  | Run

newtype Identifier = Identifier { identifier_string :: String }

data MakeClause = MakeClause (AndList DeclaratorId) Cxx.Basics.MakeDeclaration

flatten_MakeClauses :: AndList MakeClause → [(Cxx.Basics.MakeDeclaration, DeclaratorId)]
flatten_MakeClauses = concatMap (\(MakeClause (AndList l) d) → map ((,) d) (toList l)) . toList . andList

-- Convenience constructors

front, back :: Bound
front = Bound (Just Before) Everything
back = Bound (Just After) Everything

-- Convert/Invertible/Functor Instances

instance Functor EverythingOr where
  fmap _ Everything = Everything
  fmap f (NotEverything x) = NotEverything (f x)

instance Functor Ranked where
  fmap f (Ranked o x) = Ranked o (f x)
  fmap f (Sole x) = Sole (f x)

instance Functor Rankeds where
  fmap f (Rankeds o x) = Rankeds o $ f x
  fmap f (Sole' x) = Sole' $ f x
  fmap f (All x) = All $ f x
  fmap f (AllBut o x) = AllBut o $ f x

instance Functor Relative where
  fmap f (Absolute x) = Absolute $ f x
  fmap f (Relative x ba r) = Relative (f x) ba r
  fmap f (Between x b) = Between (f x) b
  fmap _ (FromTill a b) = FromTill a b

instance Convert (Ranked a) (Rankeds a) where
  convert (Ranked o x) = Rankeds (and_one $ OccurrencesClause $ return o) x
  convert (Sole x) = Sole' x

instance Convert (Range a) (Range a) where convert = id
instance Convert (StickyRange a) (Range a) where convert = unanchor_range
instance Convert (Anchor a) (Pos a) where convert = anchor_pos
instance Convert (StickyRange Char) DualStickyRange where convert x = DualStickyRange x x

instance Invertible Side where invert Before = After; invert After = Before

instance Invertible (Ranked a) where
  invert (Ranked r s) = Ranked (invert r) s
  invert x = x

instance Invertible OccurrencesClause where
  invert (OccurrencesClause l) = OccurrencesClause $ invert . l

instance Invertible (Rankeds a) where
  invert (Rankeds (AndList r) s) = Rankeds (AndList $ invert . r) s
  invert x = x

-- Misc operations

unrelative :: Relative a → Maybe a
unrelative (Absolute x) = Just x
unrelative (Relative x _ _) = Just x
unrelative (Between x _) = Just x
unrelative _ = Nothing
  -- Hm, this is slightly weird. You'd expect all "Relative a"s to contain an a.

merge_commands :: [Command] → [Command]
merge_commands [] = []
merge_commands (Erase l : Erase l' : r) = merge_commands $ Erase (l <> l') : r
merge_commands
  (Replace (AndList (neElim → (Replacer (Substrs x) [], []))) :
  Replace (AndList (neElim → (Replacer (Substrs y) [], []))) : r) =
    merge_commands $ Replace (and_one $ Replacer (Substrs $ x <> y) []) : r
merge_commands (h:t) = h : merge_commands t

describe_position_after :: Pos Char → String → Position
describe_position_after n s
  | pos n == 0 = Position Before $ In (Absolute Everything) Nothing
  | pos n == length s = Position After $ In (Absolute Everything) Nothing
  | otherwise = Position After $ In (Absolute $ NotEverything $ Sole $ Right $ concat $ reverse $ take_atleast 7 length $ reverse $ edit_tokens isIdChar $ take (pos n) s) Nothing

-- Tokenization:

edit_tokens :: (Char → Bool) → String → [String]
  -- First parameter is a predicate for identifier characters; sometimes we want "foo_bar" to be ["foo", "_", "bar"], but sometimes we want it to be ["foo_bar"].
  -- Literals are not parsed as single tokens. A sequence of spaces is parsed as a single token.
edit_tokens p = work
  where
    work [] = []
    work s | Just (o, s') ← findMaybe (\q → (\x → (q, x)) . List.stripPrefix q s) Cxx.Basics.long_ops = o : work s'
    work (' ':s) = let (x, s') = span Char.isSpace s in (' ':x) : work s'
    work (h:s) | Char.isDigit h = let (x, s') = span Char.isDigit s in (h:x) : work s'
    work (h:s) | p h = let (x, s') = span p s in (h:x) : work s'
    work (h:s) = [h] : work s

data Token = Token { tok_text, tok_white :: String }

instance Eq Token where (==) = (==) `on` tok_text

tok_len :: Token → Int
tok_len (Token x y) = length x + length y

toks_len :: [Token] → Int
toks_len = sum . (tok_len .)

instance Semigroup Token where
  Token x y <> Token "" y' = Token x (y ++ y')
  Token x y <> Token x' y' = Token (x ++ y ++ x') y'

instance Monoid Token where
  mempty = Token "" ""

toks_text :: [Token] → String
toks_text = tok_text . mconcat