content: {-# LANGUAGE UnicodeSyntax, MultiParamTypeClasses, PatternGuards, FlexibleInstances, TypeSynonymInstances, OverlappingInstances, ViewPatterns, FlexibleContexts, RecordWildCards, NamedFieldPuns, GeneralizedNewtypeDeriving #-}
  
  module Editing.Basics (Pos(Pos, pos), positionIn, Anchor(..), Side(..), StickyRange, Range(..), TextEdit(..), tightRange, unanchor_range, selectRange, Offsettable(..), showEditOperand, showTextEdit, find_occs, wideRange, stickyRange, end, contained_in, merge_contiguous, makeMoveEdit, replaceRange, Adjuster(..), adjuster, rangeFromTo, frontPos, frontAnchor, fullRange) where
  
  import qualified Data.List as List
  import qualified Data.Char as Char
  import qualified Data.List.NonEmpty as NeList
  import Control.Arrow ((&&&))
  import Data.List.NonEmpty (NonEmpty((:|)))
  import Data.Semigroup (Semigroup(..))
  import Data.Monoid (Monoid(..))
  import Data.Ord (comparing)
  import Util ((.), NeList, neElim, E, nothingAsError, Apply(..), isIdChar, none, MyMonadError(..))
  
  import Prelude.Unicode
  import Prelude hiding ((.))
  
  -- Offset
  
  class Offsettable a where offset :: Int → a → a
  
  instance (Offsettable a, Offsettable b) ⇒ Offsettable (a, b) where offset i (x, y) = (offset i x, offset i y)
  instance Offsettable a ⇒ Offsettable [a] where offset = fmap . offset
  instance Offsettable Int where offset = (+)
  instance Offsettable (Pos a) where offset x (Pos p) = Pos (p + x)
  instance Offsettable (Range a) where offset x (Range y z) = Range (offset x y) z
  instance Offsettable (Anchor a) where offset x (Anchor y z) = Anchor y (offset x z)
  instance Offsettable (StickyRange a) where offset = (.) . offset
  instance Offsettable (TextEdit a) where
    offset i (RangeReplaceEdit r s) = RangeReplaceEdit (offset i r) s
    offset i (MoveEdit ba j r) = MoveEdit ba (offset i j) (offset i r)
    offset i (InsertEdit a s) = InsertEdit (offset i a) s
  
  -- Positions
  
  newtype Pos a = Pos {pos :: Int}
    deriving (Eq, Ord, Enum)
      -- The 'a' phantom parameter denotes the element type for the position. This prevents accidental mix-ups of different kinds of positions. The Pos constructor should be used as little as possible.
  
  positionIn :: [a] → Int → Pos a
  positionIn _ = Pos
  
  frontPos :: Pos a
  frontPos = Pos 0
  
  backPos :: [a] → Pos a
  backPos l = Pos (length l)
  
  find_occs :: Eq a ⇒ [a] → [a] → [Pos a]
  find_occs x = map (Pos . fst) . filter (List.isPrefixOf x . snd) . zip [0..] . List.tails
  
  splitAtPos :: Pos a → [a] → ([a], [a])
  splitAtPos = splitAt . pos
  
  instance Show (Pos a) where show = show . pos
  
  -- Ranges
  
  data Range a = Range { start :: Pos a, size :: Int } deriving Eq
  
  rangeFromTo :: Pos a → Pos a → Range a
  rangeFromTo from to = Range from (pos to - pos from)
  
  fullRange :: [a] → Range a
  fullRange l = rangeFromTo frontPos (backPos l)
  
  end :: Range a → Pos a
  end Range{..} = offset size start
  
  splitRange :: Range a → [a] → ([a], [a], [a])
  splitRange Range{..} (splitAt (pos start) → (x, splitAt size → (y, z))) = (x, y, z)
  
  selectRange :: Range a → [a] → [a]
  selectRange Range{..} = take size . drop (pos start)
  
  replaceRange :: Range a → [a] → [a] → [a]
  replaceRange r replacement (splitRange r → (pre, _, post)) = pre ++ replacement ++ post
  
  contained_in :: Range a → Range a → Bool
  contained_in x y = start y ≤ start x ∧ end x ≤ end y
  
  overlap :: Range a → Range a → Int
  overlap (Range x s) (Range x' s') = max 0 $ min (pos x + s) (pos x' + s') - max (pos x) (pos x')
  
  touch :: Range a → Range a → Bool
  touch x y = end x ≥ start y ∧ end y ≥ start x
  
  -- Sticky positions and ranges
  
  data Side = Before | After deriving (Eq, Ord)
  
  data Anchor a = Anchor { anchor_side :: Side, anchor_pos :: Pos a } deriving Eq
  
  instance Ord (Anchor a) where compare = comparing (anchor_pos &&& anchor_side)
  
  frontAnchor :: Anchor a
  frontAnchor = Anchor Before frontPos
  
  type StickyRange a = Side → Anchor a
  
  stickyRange :: Anchor a → Anchor a → StickyRange a
  stickyRange x _ Before = x
  stickyRange _ x After = x
  
  unanchor_range :: StickyRange a → Range a
  unanchor_range r | Anchor _ x ← r Before, Anchor _ y ← r After = Range x (pos y - pos x)
  
  wideRange, tightRange :: Range a → StickyRange a
  wideRange r = stickyRange (Anchor Before $ start r) (Anchor After $ end r)
  tightRange r = stickyRange (Anchor After $ start r) (Anchor Before $ end r)
  
  two_contiguous :: StickyRange a → StickyRange a → Maybe (StickyRange a)
  two_contiguous x y
    | touch (unanchor_range x) (unanchor_range y) = Just $ stickyRange (min (x Before) (y Before)) (max (x After) (y After))
    | otherwise = Nothing
  
  findWithRest :: (a → Maybe b) → [a] → Maybe (b, [a])
  findWithRest p = work []
    where
      work _ [] = Nothing
      work old (h:t)
        | Just b ← p h = Just (b, old ++ t)
        | otherwise = work (h:old) t
  
  contiguous :: NeList (StickyRange a) → Maybe (StickyRange a)
  contiguous l = case NeList.tail l of
    [] → Just $ NeList.head l
    t → findWithRest (two_contiguous $ NeList.head l) t >>= contiguous . uncurry (:|)
  
  merge_contiguous :: NeList (StickyRange a) → NeList (StickyRange a)
  merge_contiguous l = case neElim l of
    (_, []) → l
    (h, t@(x:xs)) → case findWithRest (two_contiguous h) t of
      Nothing → NeList.cons h (merge_contiguous $ x :| xs)
      Just (h', t') → merge_contiguous $ h' :| t'
  
  -- Edits
  
  data TextEdit a
    = RangeReplaceEdit (Range a) [a]
    | InsertEdit (Anchor a) [a]
      -- We don't just use a RangeReplaceEdit with empty range for insertions, because it is not expressive enough. For instance, given "xy", insertions at the positions "after x" and "before y" would both designate position 1, but a prior "add z after x" edit should increment the latter position but not the former. The Anchor's Side expresses this difference.
    | MoveEdit Side Int (Range a)
      -- MoveEdit's Int is an offset. If it is a nonnegative number n, the insert position is n characters beyond the end of the source range. If it is a negative number -n, the insert position is n characters before the start of the source range. We use this instead of a normal Anchor because it ensures that silly "move into self"-edits are not representable. This constructor must not be used by anyone but the makeMoveEdit smart constructor, which detects such edits.
    deriving Eq
      -- The source ranges for move and replace are implicitly narrow-sticky (i.e. right-sticky begin & left-sticky end).
  
  makeMoveEdit :: MyMonadError String m ⇒ Anchor a → Range a → m (TextEdit a)
  makeMoveEdit (Anchor ba p) r
    | p ≤ start r = return $ MoveEdit ba (pos p - pos (start r)) r
    | end r ≤ p = return $ MoveEdit ba (pos p - pos (start r) - size r) r
    | otherwise = throwError "Move destination lies in source range."
  
  instance Apply (TextEdit a) [a] [a] where
    apply e s = case e of
      RangeReplaceEdit r repl → replaceRange r repl s
      InsertEdit (Anchor _ p) repl → let (x, y) = splitAtPos p s in x ++ repl ++ y
      MoveEdit _ p r
        | p < 0 → let (splitAtPos (offset p (start r)) → (x, y), z, w) = splitRange r s in x ++ z ++ y ++ w
        | otherwise → let (x, y, splitAt p → (z, u)) = splitRange r s in x ++ z ++ y ++ u
  
  -- More regular edit representation used during adjustment below.
  
  data Replacement a = Replacement { repl_what :: Range a, repl_length :: Int }
  
  insertion :: Pos a → Int → Replacement a
  insertion p s = Replacement (Range p 0) s
  
  erasure :: Range a → Replacement a
  erasure = flip Replacement 0
  
  -- Adjustment
  
  adjust_with_insertion :: (Pos a, Int) → Anchor a → Anchor a
    -- How does the insertion at the given place of a given number of things change an Anchor?
  adjust_with_insertion (p, s) a@Anchor{..}
    | (anchor_side == After ∧ p == anchor_pos) ∨ p < anchor_pos = offset s a
    | otherwise = a
  
  class Adjust a b where adjust :: a → b → Maybe b
  
  instance Adjust (TextEdit a) (Anchor a) where
    adjust (InsertEdit (Anchor _ p) s) a@Anchor{..} = Just $ adjust_with_insertion (p, length s) a
    adjust (RangeReplaceEdit r []) a
      | a == Anchor After (start r) = Just $ Anchor Before (start r)
      | a == Anchor Before (end r) = Just $ Anchor After (start r)
    adjust (RangeReplaceEdit r repl) a@Anchor{anchor_pos}
      | end r ≤ anchor_pos = Just $ offset (length repl - size r) a
      | anchor_pos ≤ start r = Just a
      | otherwise = Nothing
    adjust (MoveEdit _ p r) a@Anchor{..}
      | start r < anchor_pos, anchor_pos < end r = Just $ offset p a
      | p < 0 = adjust_with_insertion (offset p (start r), size r) . adjust (RangeReplaceEdit r []) a
      | otherwise = adjust (RangeReplaceEdit r []) (adjust_with_insertion (offset p (end r), size r) a)
  
  instance Adjust (Replacement a) (Replacement a) where
    adjust (Replacement r l) re@(Replacement r' l')
      | end r ≤ start r' = Just $ re{repl_what=offset (l - size r) r'} -- This reflects that we treat (begin r') as left-sticky.
      | end r' ≤ start r = Just re -- This reflects that we treat (end r') as left-sticky.
      | l == 0, l' == 0 = Just re{repl_what = if start r ≤ start r'
          then Range (start r) (max 0 $ pos (end r') - pos (end r))
          else Range (start r') (size r' - overlap r r')}
      | otherwise = Nothing
  
  instance Adjust (TextEdit a) (Replacement a) where
    adjust (RangeReplaceEdit r repl) r' = adjust (Replacement r (length repl)) r'
    adjust (InsertEdit (Anchor _ p) s) r = adjust (insertion p (length s)) r
    adjust (MoveEdit _ p r) r'
      | repl_what r' `contained_in` r = Just $ r'{repl_what = offset p (repl_what r')}
      | p < 0 = adjust (erasure r) r' >>= adjust (insertion (offset p (start r)) (size r))
      | otherwise = adjust (insertion (offset p (end r)) (size r)) r' >>= adjust (erasure r)
  
  instance Adjust (TextEdit a) (TextEdit a) where
    adjust e (InsertEdit a s) = flip InsertEdit s . adjust e a
    adjust e (MoveEdit ba p r) = do
      r' ← repl_what . adjust e (erasure r)
      a ← adjust e $ Anchor ba $ offset p ((if p < 0 then start else end) r)
      makeMoveEdit a r'
    adjust e (RangeReplaceEdit r s) = flip RangeReplaceEdit s . repl_what . adjust e (Replacement r (length s))
  
  data Adjuster a = Adjuster
    { editAdjuster :: TextEdit a → E (Maybe (TextEdit a))
    , anchorAdjuster :: Anchor a → E (Anchor a) }
  
  instance Semigroup (Adjuster a) where
    x <> y = Adjuster
      { editAdjuster = (>>= maybe (return Nothing) (editAdjuster y)) . editAdjuster x
      , anchorAdjuster = \a → anchorAdjuster x a >>= anchorAdjuster y }
  
  instance Monoid (Adjuster a) where
    mempty = Adjuster { editAdjuster = return . return, anchorAdjuster = return }
  
  adjuster :: String → TextEdit Char → Adjuster Char
  adjuster s add = Adjuster
    { editAdjuster = \e → if add == e then return Nothing else case adjust add e of
        Just e' → return $ Just e'
        _ → Left $ "Overlapping edits: " ++ showTextEdit s add ++ " and " ++ showTextEdit s e ++ "."
    , anchorAdjuster = nothingAsError msg . adjust add }
    where msg = "Could not adjust anchor in original snippet to anchor in well formed snippet."
  
  -- Display
  
  showEditOperand :: String → String
  showEditOperand " " = "space"
  showEditOperand "," = "comma"
  showEditOperand ":" = "colon"
  showEditOperand ";" = "semicolon"
  showEditOperand s
    | all Char.isSpace s = "spaces"
    | all isIdChar s = s
    | none (`elem` " ,;") s, length s < 10 = s
    | otherwise = '`' : s ++ "`"
  
  showTextEdit :: String → TextEdit Char → String
  showTextEdit _ (RangeReplaceEdit (Range (Pos 0) 0) r) = "prepend " ++ showEditOperand r
  showTextEdit s (RangeReplaceEdit (Range (Pos t) _) r) | t == length s = "append " ++ showEditOperand r
  showTextEdit _ (RangeReplaceEdit (Range _ 0) r) = "insert " ++ showEditOperand r
  showTextEdit _ (InsertEdit _ r) = "insert " ++ showEditOperand r
  showTextEdit s (RangeReplaceEdit r "") = "erase " ++ showEditOperand (selectRange r s)
  showTextEdit s (RangeReplaceEdit r s') = "replace " ++ showEditOperand (selectRange r s) ++ " with " ++ showEditOperand s'
  showTextEdit s (MoveEdit _ _ r) = "move " ++ showEditOperand (selectRange r s)
  