{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternGuards #-}
{-# OPTIONS_HADDOCK show-extensions #-}

-- |
-- Module      :  Yi.Mode.Haskell.Dollarify
-- License     :  GPL-2
-- Maintainer  :  yi-devel@googlegroups.com
-- Stability   :  experimental
-- Portability :  portable

module Yi.Mode.Haskell.Dollarify where

import           Control.Monad       (unless)
import           Data.Function       (on)
import           Data.List           (sortBy)
import           Data.Maybe          (fromMaybe)
import           Data.Monoid         ((<>))
import           Data.Text           ()
import           Yi.Buffer           hiding (Block)
import           Yi.Debug            (trace)
import           Yi.Lexer.Alex       (Tok (..), posnOfs)
import           Yi.Lexer.Haskell    (TT, Token (..), isComment)
import qualified Yi.Rope             as R (YiString, null)
import           Yi.String           (showT)
import qualified Yi.Syntax.Haskell   as H (Exp (..), Tree)
import           Yi.Syntax.Paren     (Expr, Tree (..))
import           Yi.Syntax.Tree      (getAllSubTrees, getFirstOffset, getLastOffset, getLastPath)

dollarify :: Tree TT -> BufferM ()
dollarify :: Tree TT -> BufferM ()
dollarify Tree TT
t = BufferM ()
-> (Tree TT -> BufferM ()) -> Maybe (Tree TT) -> BufferM ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> BufferM ()
forall a. a -> BufferM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) Tree TT -> BufferM ()
dollarifyWithin (Maybe (Tree TT) -> BufferM ())
-> (Region -> Maybe (Tree TT)) -> Region -> BufferM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tree TT] -> Region -> Maybe (Tree TT)
selectedTree [Tree TT
t] (Region -> BufferM ()) -> BufferM Region -> BufferM ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< BufferM Region
getSelectRegionB

dollarifyWithin :: Tree TT -> BufferM ()
dollarifyWithin :: Tree TT -> BufferM ()
dollarifyWithin = Text -> BufferM () -> BufferM ()
forall a. Text -> a -> a
trace (Text -> BufferM () -> BufferM ())
-> (Tree TT -> Text) -> Tree TT -> BufferM () -> BufferM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"dollarifyWithin: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> (Tree TT -> Text) -> Tree TT -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree TT -> Text
forall a. Show a => a -> Text
showT (Tree TT -> BufferM () -> BufferM ())
-> (Tree TT -> BufferM ()) -> Tree TT -> BufferM ()
forall a b. (Tree TT -> a -> b) -> (Tree TT -> a) -> Tree TT -> b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [QueuedUpdate] -> BufferM ()
runQ ([QueuedUpdate] -> BufferM ())
-> (Tree TT -> [QueuedUpdate]) -> Tree TT -> BufferM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tree TT -> [QueuedUpdate]
dollarifyTop (Tree TT -> [QueuedUpdate]) -> [Tree TT] -> [QueuedUpdate]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) ([Tree TT] -> [QueuedUpdate])
-> (Tree TT -> [Tree TT]) -> Tree TT -> [QueuedUpdate]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree TT -> [Tree TT]
forall (tree :: * -> *) t. IsTree tree => tree t -> [tree t]
getAllSubTrees

data QueuedUpdate = QueuedUpdate { QueuedUpdate -> Point
qUpdatePoint :: Point
                                 , QueuedUpdate -> YiString
qInsert      :: R.YiString
                                 , QueuedUpdate -> Int
qDelete      :: Int
                                 } deriving (QueuedUpdate -> QueuedUpdate -> Bool
(QueuedUpdate -> QueuedUpdate -> Bool)
-> (QueuedUpdate -> QueuedUpdate -> Bool) -> Eq QueuedUpdate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: QueuedUpdate -> QueuedUpdate -> Bool
== :: QueuedUpdate -> QueuedUpdate -> Bool
$c/= :: QueuedUpdate -> QueuedUpdate -> Bool
/= :: QueuedUpdate -> QueuedUpdate -> Bool
Eq, Eq QueuedUpdate
Eq QueuedUpdate =>
(QueuedUpdate -> QueuedUpdate -> Ordering)
-> (QueuedUpdate -> QueuedUpdate -> Bool)
-> (QueuedUpdate -> QueuedUpdate -> Bool)
-> (QueuedUpdate -> QueuedUpdate -> Bool)
-> (QueuedUpdate -> QueuedUpdate -> Bool)
-> (QueuedUpdate -> QueuedUpdate -> QueuedUpdate)
-> (QueuedUpdate -> QueuedUpdate -> QueuedUpdate)
-> Ord QueuedUpdate
QueuedUpdate -> QueuedUpdate -> Bool
QueuedUpdate -> QueuedUpdate -> Ordering
QueuedUpdate -> QueuedUpdate -> QueuedUpdate
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: QueuedUpdate -> QueuedUpdate -> Ordering
compare :: QueuedUpdate -> QueuedUpdate -> Ordering
$c< :: QueuedUpdate -> QueuedUpdate -> Bool
< :: QueuedUpdate -> QueuedUpdate -> Bool
$c<= :: QueuedUpdate -> QueuedUpdate -> Bool
<= :: QueuedUpdate -> QueuedUpdate -> Bool
$c> :: QueuedUpdate -> QueuedUpdate -> Bool
> :: QueuedUpdate -> QueuedUpdate -> Bool
$c>= :: QueuedUpdate -> QueuedUpdate -> Bool
>= :: QueuedUpdate -> QueuedUpdate -> Bool
$cmax :: QueuedUpdate -> QueuedUpdate -> QueuedUpdate
max :: QueuedUpdate -> QueuedUpdate -> QueuedUpdate
$cmin :: QueuedUpdate -> QueuedUpdate -> QueuedUpdate
min :: QueuedUpdate -> QueuedUpdate -> QueuedUpdate
Ord, Int -> QueuedUpdate -> ShowS
[QueuedUpdate] -> ShowS
QueuedUpdate -> String
(Int -> QueuedUpdate -> ShowS)
-> (QueuedUpdate -> String)
-> ([QueuedUpdate] -> ShowS)
-> Show QueuedUpdate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> QueuedUpdate -> ShowS
showsPrec :: Int -> QueuedUpdate -> ShowS
$cshow :: QueuedUpdate -> String
show :: QueuedUpdate -> String
$cshowList :: [QueuedUpdate] -> ShowS
showList :: [QueuedUpdate] -> ShowS
Show)

runQ :: [QueuedUpdate] -> BufferM ()
runQ :: [QueuedUpdate] -> BufferM ()
runQ = Text -> BufferM () -> BufferM ()
forall a. Text -> a -> a
trace (Text -> BufferM () -> BufferM ())
-> ([QueuedUpdate] -> Text)
-> [QueuedUpdate]
-> BufferM ()
-> BufferM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"runQ: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text)
-> ([QueuedUpdate] -> Text) -> [QueuedUpdate] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [QueuedUpdate] -> Text
forall a. Show a => a -> Text
showT ([QueuedUpdate] -> BufferM () -> BufferM ())
-> ([QueuedUpdate] -> BufferM ()) -> [QueuedUpdate] -> BufferM ()
forall a b.
([QueuedUpdate] -> a -> b)
-> ([QueuedUpdate] -> a) -> [QueuedUpdate] -> b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (QueuedUpdate -> BufferM ()) -> [QueuedUpdate] -> BufferM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ QueuedUpdate -> BufferM ()
run1Q ([QueuedUpdate] -> BufferM ())
-> ([QueuedUpdate] -> [QueuedUpdate])
-> [QueuedUpdate]
-> BufferM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (QueuedUpdate -> QueuedUpdate -> Ordering)
-> [QueuedUpdate] -> [QueuedUpdate]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((QueuedUpdate -> QueuedUpdate -> Ordering)
-> QueuedUpdate -> QueuedUpdate -> Ordering
forall a b c. (a -> b -> c) -> b -> a -> c
flip QueuedUpdate -> QueuedUpdate -> Ordering
forall a. Ord a => a -> a -> Ordering
compare)
    where
       run1Q :: QueuedUpdate -> BufferM ()
       run1Q :: QueuedUpdate -> BufferM ()
run1Q (QueuedUpdate { qUpdatePoint :: QueuedUpdate -> Point
qUpdatePoint = Point
p, qInsert :: QueuedUpdate -> YiString
qInsert = YiString
i, qDelete :: QueuedUpdate -> Int
qDelete = Int
d })
              = do Direction -> Int -> Point -> BufferM ()
deleteNAt Direction
Forward Int
d Point
p
                   Bool -> BufferM () -> BufferM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (YiString -> Bool
R.null YiString
i) (BufferM () -> BufferM ()) -> BufferM () -> BufferM ()
forall a b. (a -> b) -> a -> b
$ YiString -> Point -> BufferM ()
insertNAt YiString
i Point
p

openParen, closeParen :: Token
openParen :: Token
openParen = Char -> Token
Special Char
'('
closeParen :: Token
closeParen = Char -> Token
Special Char
')'

isNormalParen :: Tree TT -> Bool
isNormalParen :: Tree TT -> Bool
isNormalParen (Paren TT
t1 [Tree TT]
xs TT
t2) =
  TT -> Token
forall t. Tok t -> t
tokT TT
t1 Token -> Token -> Bool
forall a. Eq a => a -> a -> Bool
== Token
openParen Bool -> Bool -> Bool
&& TT -> Token
forall t. Tok t -> t
tokT TT
t2 Token -> Token -> Bool
forall a. Eq a => a -> a -> Bool
== Token
closeParen Bool -> Bool -> Bool
&& Bool -> Bool
not ((Tree TT -> Bool) -> [Tree TT] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Tree TT -> Bool
isTuple [Tree TT]
xs)
isNormalParen Tree TT
_               = Bool
False

isTuple ::Tree TT -> Bool
isTuple :: Tree TT -> Bool
isTuple (Atom TT
t) = TT -> Token
forall t. Tok t -> t
tokT TT
t Token -> Token -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Token
Special Char
','
isTuple Tree TT
_ = Bool
False

-- Assumes length of token is one character
queueDelete :: TT -> QueuedUpdate
queueDelete :: TT -> QueuedUpdate
queueDelete = YiString -> TT -> QueuedUpdate
queueReplaceWith YiString
""

-- Assumes length of token is one character
queueReplaceWith :: R.YiString -> TT -> QueuedUpdate
queueReplaceWith :: YiString -> TT -> QueuedUpdate
queueReplaceWith YiString
s TT
t = QueuedUpdate { qUpdatePoint :: Point
qUpdatePoint = Posn -> Point
posnOfs (Posn -> Point) -> Posn -> Point
forall a b. (a -> b) -> a -> b
$ TT -> Posn
forall t. Tok t -> Posn
tokPosn TT
t
                                    , qInsert :: YiString
qInsert = YiString
s
                                    , qDelete :: Int
qDelete = Int
1
                                    }

-- Only strips comments from the top level
stripComments :: Expr TT -> Expr TT
stripComments :: [Tree TT] -> [Tree TT]
stripComments = (Tree TT -> Bool) -> [Tree TT] -> [Tree TT]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Tree TT -> Bool) -> [Tree TT] -> [Tree TT])
-> (Tree TT -> Bool) -> [Tree TT] -> [Tree TT]
forall a b. (a -> b) -> a -> b
$ \Tree TT
t -> case Tree TT
t of { (Atom TT
x) -> Bool -> Bool
not (Token -> Bool
isComment (Token -> Bool) -> Token -> Bool
forall a b. (a -> b) -> a -> b
$ TT -> Token
forall t. Tok t -> t
tokT TT
x); Tree TT
_ -> Bool
True }

dollarifyTop :: Tree TT -> [QueuedUpdate]
dollarifyTop :: Tree TT -> [QueuedUpdate]
dollarifyTop p :: Tree TT
p@(Paren TT
t1 [Tree TT]
e TT
t2)
   | Tree TT -> Bool
isNormalParen Tree TT
p = case [Tree TT] -> [Tree TT]
stripComments [Tree TT]
e of
       [Paren{}] -> [TT -> QueuedUpdate
queueDelete TT
t2, TT -> QueuedUpdate
queueDelete TT
t1]
       [Tree TT]
e'        -> [Tree TT] -> [QueuedUpdate]
dollarifyExpr [Tree TT]
e'
dollarifyTop (Block [Tree TT]
blk) = [Tree TT] -> [QueuedUpdate]
dollarifyExpr ([Tree TT] -> [QueuedUpdate])
-> ([Tree TT] -> [Tree TT]) -> [Tree TT] -> [QueuedUpdate]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tree TT] -> [Tree TT]
stripComments ([Tree TT] -> [QueuedUpdate]) -> [[Tree TT]] -> [QueuedUpdate]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [[Tree TT]
x | Expr [Tree TT]
x <- [Tree TT]
blk]
dollarifyTop Tree TT
_ = []

-- Expression must not contain comments
dollarifyExpr :: Expr TT -> [QueuedUpdate]
dollarifyExpr :: [Tree TT] -> [QueuedUpdate]
dollarifyExpr e :: [Tree TT]
e@(Tree TT
_:[Tree TT]
_)
    | p :: Tree TT
p@(Paren TT
t [Tree TT]
e2 TT
t2) <- [Tree TT] -> Tree TT
forall a. HasCallStack => [a] -> a
last [Tree TT]
e
    , Tree TT -> Bool
isNormalParen Tree TT
p
    , (Tree TT -> Bool) -> [Tree TT] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Tree TT -> Bool
isSimple [Tree TT]
e
    = let dollarifyLoop :: Expr TT -> [QueuedUpdate]
          dollarifyLoop :: [Tree TT] -> [QueuedUpdate]
dollarifyLoop [] = []
          dollarifyLoop e3 :: [Tree TT]
e3@[Paren{}] = [Tree TT] -> [QueuedUpdate]
dollarifyExpr [Tree TT]
e3
          dollarifyLoop [Tree TT]
e3 = if [Tree TT] -> Bool
isCollapsible [Tree TT]
e3 then [TT -> QueuedUpdate
queueDelete TT
t2, YiString -> TT -> QueuedUpdate
queueReplaceWith YiString
"$ " TT
t] else []
          in [Tree TT] -> [QueuedUpdate]
dollarifyLoop ([Tree TT] -> [QueuedUpdate]) -> [Tree TT] -> [QueuedUpdate]
forall a b. (a -> b) -> a -> b
$ [Tree TT] -> [Tree TT]
stripComments [Tree TT]
e2
dollarifyExpr [Tree TT]
_ = []

isSimple :: Tree TT -> Bool
isSimple :: Tree TT -> Bool
isSimple (Paren{}) = Bool
True
isSimple (Block{}) = Bool
False
isSimple (Atom TT
t)  = TT -> Token
forall t. Tok t -> t
tokT TT
t Token -> [Token] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Token
Number, Token
CharTok, Token
StringTok, Token
VarIdent, Token
ConsIdent]
isSimple Tree TT
_         = Bool
False

-- Expression must not contain comments
isCollapsible :: Expr TT -> Bool
isCollapsible :: [Tree TT] -> Bool
isCollapsible = (Bool -> Bool -> Bool
(&&) (Bool -> Bool -> Bool)
-> (Tree TT -> Bool) -> Tree TT -> Tree TT -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Tree TT -> Bool
isSimple) (Tree TT -> Tree TT -> Bool)
-> ([Tree TT] -> Tree TT) -> [Tree TT] -> Tree TT -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tree TT] -> Tree TT
forall a. HasCallStack => [a] -> a
head ([Tree TT] -> Tree TT -> Bool)
-> ([Tree TT] -> Tree TT) -> [Tree TT] -> Bool
forall a b.
([Tree TT] -> a -> b) -> ([Tree TT] -> a) -> [Tree TT] -> b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Tree TT] -> Tree TT
forall a. HasCallStack => [a] -> a
last

selectedTree :: Expr TT -> Region -> Maybe (Tree TT)
selectedTree :: [Tree TT] -> Region -> Maybe (Tree TT)
selectedTree [Tree TT]
e Region
r = Region -> [Tree TT] -> Tree TT
findLargestWithin Region
r ([Tree TT] -> Tree TT) -> Maybe [Tree TT] -> Maybe (Tree TT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Tree TT] -> Point -> Maybe [Tree TT]
forall (tree :: * -> *) t.
IsTree tree =>
[tree (Tok t)] -> Point -> Maybe [tree (Tok t)]
getLastPath [Tree TT]
e (Region -> Point
regionLast Region
r)

-- List must be non-empty
findLargestWithin :: Region -> [Tree TT] -> Tree TT
findLargestWithin :: Region -> [Tree TT] -> Tree TT
findLargestWithin Region
r = Tree TT -> Maybe (Tree TT) -> Tree TT
forall a. a -> Maybe a -> a
fromMaybe (Tree TT -> Maybe (Tree TT) -> Tree TT)
-> ([Tree TT] -> Tree TT)
-> [Tree TT]
-> Maybe (Tree TT)
-> Tree TT
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tree TT] -> Tree TT
forall a. HasCallStack => [a] -> a
head ([Tree TT] -> Maybe (Tree TT) -> Tree TT)
-> ([Tree TT] -> Maybe (Tree TT)) -> [Tree TT] -> Tree TT
forall a b.
([Tree TT] -> a -> b) -> ([Tree TT] -> a) -> [Tree TT] -> b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Tree TT] -> Maybe (Tree TT)
forall a. [a] -> Maybe a
safeLast ([Tree TT] -> Maybe (Tree TT))
-> ([Tree TT] -> [Tree TT]) -> [Tree TT] -> Maybe (Tree TT)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tree TT -> Bool) -> [Tree TT] -> [Tree TT]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Region -> Tree TT -> Bool
within Region
r)

within :: Region -> Tree TT -> Bool
within :: Region -> Tree TT -> Bool
within Region
r Tree TT
t = Region -> Region -> Bool
includedRegion ((Point -> Point -> Region
mkRegion (Point -> Point -> Region)
-> (Tree TT -> Point) -> Tree TT -> Point -> Region
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree TT -> Point
forall (t :: * -> *) t1. Foldable t => t (Tok t1) -> Point
getFirstOffset (Tree TT -> Point -> Region)
-> (Tree TT -> Point) -> Tree TT -> Region
forall a b. (Tree TT -> a -> b) -> (Tree TT -> a) -> Tree TT -> b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Tree TT -> Point
forall (t :: * -> *) t1. Foldable t => t (Tok t1) -> Point
getLastOffset) Tree TT
t) Region
r

safeLast :: [a] -> Maybe a
safeLast :: forall a. [a] -> Maybe a
safeLast [] = Maybe a
forall a. Maybe a
Nothing
safeLast [a]
s  = a -> Maybe a
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ [a] -> a
forall a. HasCallStack => [a] -> a
last [a]
s

-- Here follows code for the precise haskell mode

dollarifyP :: H.Tree TT -> BufferM ()
dollarifyP :: Exp TT -> BufferM ()
dollarifyP Exp TT
e = BufferM ()
-> (Exp TT -> BufferM ()) -> Maybe (Exp TT) -> BufferM ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> BufferM ()
forall a. a -> BufferM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) Exp TT -> BufferM ()
dollarifyWithinP (Maybe (Exp TT) -> BufferM ())
-> (Region -> Maybe (Exp TT)) -> Region -> BufferM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Exp TT] -> Region -> Maybe (Exp TT)
selectedTreeP [Exp TT
e] (Region -> BufferM ()) -> BufferM Region -> BufferM ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< BufferM Region
getSelectRegionB

dollarifyWithinP :: H.Exp TT -> BufferM ()
dollarifyWithinP :: Exp TT -> BufferM ()
dollarifyWithinP = Text -> BufferM () -> BufferM ()
forall a. Text -> a -> a
trace (Text -> BufferM () -> BufferM ())
-> (Exp TT -> Text) -> Exp TT -> BufferM () -> BufferM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"dollarifyWithin: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> (Exp TT -> Text) -> Exp TT -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp TT -> Text
forall a. Show a => a -> Text
showT (Exp TT -> BufferM () -> BufferM ())
-> (Exp TT -> BufferM ()) -> Exp TT -> BufferM ()
forall a b. (Exp TT -> a -> b) -> (Exp TT -> a) -> Exp TT -> b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [QueuedUpdate] -> BufferM ()
runQ ([QueuedUpdate] -> BufferM ())
-> (Exp TT -> [QueuedUpdate]) -> Exp TT -> BufferM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Exp TT -> [QueuedUpdate]
dollarifyTopP (Exp TT -> [QueuedUpdate]) -> [Exp TT] -> [QueuedUpdate]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) ([Exp TT] -> [QueuedUpdate])
-> (Exp TT -> [Exp TT]) -> Exp TT -> [QueuedUpdate]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp TT -> [Exp TT]
forall (tree :: * -> *) t. IsTree tree => tree t -> [tree t]
getAllSubTrees

isNormalParenP :: H.Exp TT -> Bool
isNormalParenP :: Exp TT -> Bool
isNormalParenP (H.Paren (H.PAtom TT
r [TT]
_) [Exp TT]
xs (H.PAtom TT
r' [TT]
_)) =
  TT -> Token
forall t. Tok t -> t
tokT TT
r Token -> Token -> Bool
forall a. Eq a => a -> a -> Bool
== Token
openParen Bool -> Bool -> Bool
&& TT -> Token
forall t. Tok t -> t
tokT TT
r' Token -> Token -> Bool
forall a. Eq a => a -> a -> Bool
== Token
closeParen Bool -> Bool -> Bool
&& Bool -> Bool
not ((Exp TT -> Bool) -> [Exp TT] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Exp TT -> Bool
isTupleP [Exp TT]
xs)
isNormalParenP Exp TT
_               = Bool
False

isTupleP :: H.Exp TT -> Bool
isTupleP :: Exp TT -> Bool
isTupleP (H.PAtom TT
t [TT]
_) = TT -> Token
forall t. Tok t -> t
tokT TT
t Token -> Token -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Token
Special Char
','
isTupleP Exp TT
_ = Bool
False

-- Only strips comments from the top level
stripCommentsP :: [H.Exp TT] -> [H.Exp TT]
stripCommentsP :: [Exp TT] -> [Exp TT]
stripCommentsP = (Exp TT -> Bool) -> [Exp TT] -> [Exp TT]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Exp TT -> Bool) -> [Exp TT] -> [Exp TT])
-> (Exp TT -> Bool) -> [Exp TT] -> [Exp TT]
forall a b. (a -> b) -> a -> b
$ \Exp TT
t -> case Exp TT
t of { (H.PAtom TT
x [TT]
_) -> Bool -> Bool
not (Token -> Bool
isComment (Token -> Bool) -> Token -> Bool
forall a b. (a -> b) -> a -> b
$ TT -> Token
forall t. Tok t -> t
tokT TT
x); Exp TT
_ -> Bool
True }

dollarifyTopP :: H.Exp TT -> [QueuedUpdate]
dollarifyTopP :: Exp TT -> [QueuedUpdate]
dollarifyTopP p :: Exp TT
p@(H.Paren (H.PAtom TT
t1 [TT]
_) [Exp TT]
e (H.PAtom TT
t2 [TT]
_))
   | Exp TT -> Bool
isNormalParenP Exp TT
p = case [Exp TT] -> [Exp TT]
stripCommentsP [Exp TT]
e of
       [H.Paren{}] -> [TT -> QueuedUpdate
queueDelete TT
t2, TT -> QueuedUpdate
queueDelete TT
t1]
       [Exp TT]
e'          -> [Exp TT] -> [QueuedUpdate]
dollarifyExprP [Exp TT]
e'
dollarifyTopP (H.Block [Exp TT]
bList) = [Exp TT] -> [QueuedUpdate]
dollarifyExprP ([Exp TT] -> [QueuedUpdate])
-> ([Exp TT] -> [Exp TT]) -> [Exp TT] -> [QueuedUpdate]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Exp TT] -> [Exp TT]
stripCommentsP ([Exp TT] -> [QueuedUpdate]) -> [Exp TT] -> [QueuedUpdate]
forall a b. (a -> b) -> a -> b
$ [Exp TT]
bList
dollarifyTopP Exp TT
_ = []

-- Expression must not contain comments
dollarifyExprP :: [H.Exp TT] -> [QueuedUpdate]
dollarifyExprP :: [Exp TT] -> [QueuedUpdate]
dollarifyExprP e :: [Exp TT]
e@(Exp TT
_:[Exp TT]
_)
    | p :: Exp TT
p@(H.Paren (H.PAtom TT
t [TT]
_) [Exp TT]
e2 (H.PAtom TT
t2 [TT]
_)) <- [Exp TT] -> Exp TT
forall a. HasCallStack => [a] -> a
last [Exp TT]
e
    , Exp TT -> Bool
isNormalParenP Exp TT
p
    , (Exp TT -> Bool) -> [Exp TT] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Exp TT -> Bool
isSimpleP [Exp TT]
e
    = let dollarifyLoop :: [H.Exp TT] -> [QueuedUpdate]
          dollarifyLoop :: [Exp TT] -> [QueuedUpdate]
dollarifyLoop [] = []
          dollarifyLoop e3 :: [Exp TT]
e3@[H.Paren{}] = [Exp TT] -> [QueuedUpdate]
dollarifyExprP [Exp TT]
e3
          dollarifyLoop [Exp TT]
e3 = if [Exp TT] -> Bool
isCollapsibleP [Exp TT]
e3 then [TT -> QueuedUpdate
queueDelete TT
t2, YiString -> TT -> QueuedUpdate
queueReplaceWith YiString
"$ " TT
t] else []
          in [Exp TT] -> [QueuedUpdate]
dollarifyLoop ([Exp TT] -> [QueuedUpdate]) -> [Exp TT] -> [QueuedUpdate]
forall a b. (a -> b) -> a -> b
$ [Exp TT] -> [Exp TT]
stripCommentsP [Exp TT]
e2
dollarifyExprP [Exp TT]
_ = []

isSimpleP :: H.Exp TT -> Bool
isSimpleP :: Exp TT -> Bool
isSimpleP (H.Paren{})   = Bool
True
isSimpleP (H.Block{})   = Bool
False
isSimpleP (H.PAtom TT
t [TT]
_) = TT -> Token
forall t. Tok t -> t
tokT TT
t Token -> [Token] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Token
Number, Token
CharTok, Token
StringTok, Token
VarIdent, Token
ConsIdent]
isSimpleP Exp TT
_             = Bool
False

-- Expression must not contain comments
isCollapsibleP :: [H.Exp TT] -> Bool
isCollapsibleP :: [Exp TT] -> Bool
isCollapsibleP = (Bool -> Bool -> Bool
(&&) (Bool -> Bool -> Bool)
-> (Exp TT -> Bool) -> Exp TT -> Exp TT -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Exp TT -> Bool
isSimpleP) (Exp TT -> Exp TT -> Bool)
-> ([Exp TT] -> Exp TT) -> [Exp TT] -> Exp TT -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Exp TT] -> Exp TT
forall a. HasCallStack => [a] -> a
head ([Exp TT] -> Exp TT -> Bool)
-> ([Exp TT] -> Exp TT) -> [Exp TT] -> Bool
forall a b.
([Exp TT] -> a -> b) -> ([Exp TT] -> a) -> [Exp TT] -> b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Exp TT] -> Exp TT
forall a. HasCallStack => [a] -> a
last

selectedTreeP :: [H.Exp TT] -> Region -> Maybe (H.Exp TT)
selectedTreeP :: [Exp TT] -> Region -> Maybe (Exp TT)
selectedTreeP [Exp TT]
e Region
r = Region -> [Exp TT] -> Exp TT
findLargestWithinP Region
r ([Exp TT] -> Exp TT) -> Maybe [Exp TT] -> Maybe (Exp TT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Exp TT] -> Point -> Maybe [Exp TT]
forall (tree :: * -> *) t.
IsTree tree =>
[tree (Tok t)] -> Point -> Maybe [tree (Tok t)]
getLastPath [Exp TT]
e (Region -> Point
regionLast Region
r)

-- List must be non-empty
findLargestWithinP :: Region -> [H.Exp TT] -> H.Exp TT
findLargestWithinP :: Region -> [Exp TT] -> Exp TT
findLargestWithinP Region
r = Exp TT -> Maybe (Exp TT) -> Exp TT
forall a. a -> Maybe a -> a
fromMaybe (Exp TT -> Maybe (Exp TT) -> Exp TT)
-> ([Exp TT] -> Exp TT) -> [Exp TT] -> Maybe (Exp TT) -> Exp TT
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Exp TT] -> Exp TT
forall a. HasCallStack => [a] -> a
head ([Exp TT] -> Maybe (Exp TT) -> Exp TT)
-> ([Exp TT] -> Maybe (Exp TT)) -> [Exp TT] -> Exp TT
forall a b.
([Exp TT] -> a -> b) -> ([Exp TT] -> a) -> [Exp TT] -> b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Exp TT] -> Maybe (Exp TT)
forall a. [a] -> Maybe a
safeLast ([Exp TT] -> Maybe (Exp TT))
-> ([Exp TT] -> [Exp TT]) -> [Exp TT] -> Maybe (Exp TT)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Exp TT -> Bool) -> [Exp TT] -> [Exp TT]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Region -> Exp TT -> Bool
withinP Region
r)

withinP :: Region -> H.Exp TT -> Bool
withinP :: Region -> Exp TT -> Bool
withinP Region
r Exp TT
t = Region -> Region -> Bool
includedRegion ((Point -> Point -> Region
mkRegion (Point -> Point -> Region)
-> (Exp TT -> Point) -> Exp TT -> Point -> Region
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp TT -> Point
forall (t :: * -> *) t1. Foldable t => t (Tok t1) -> Point
getFirstOffset (Exp TT -> Point -> Region)
-> (Exp TT -> Point) -> Exp TT -> Region
forall a b. (Exp TT -> a -> b) -> (Exp TT -> a) -> Exp TT -> b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Exp TT -> Point
forall (t :: * -> *) t1. Foldable t => t (Tok t1) -> Point
getLastOffset) Exp TT
t) Region
r

safeLastP :: [a] -> Maybe a
safeLastP :: forall a. [a] -> Maybe a
safeLastP [] = Maybe a
forall a. Maybe a
Nothing
safeLastP [a]
s  = a -> Maybe a
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ [a] -> a
forall a. HasCallStack => [a] -> a
last [a]
s