module Language.Desugar (
    -- * List Splitting
      tripBy
    , revTripBy
    , SplitFunction
    -- * Implicit Parenthesis
    , addParens
    , addShortParens
    -- * Simple Infixes
    , forwardInfix
    , reverseInfix
    ) where

import Data.List
import Data.Hierarchy
import Data.Hexpr


{-| Transform a list based on the presence and location of an element.

    The first function of the pair is applied when no element was found.
    Its parameter is the original list.

    The second of the pair is applied with an element is found.
    Its parameters are (in order) the preceding elements, the found element, and the
    following elements.
-}
type SplitFunction a b = ([a] -> b, [a] -> a -> [a] -> b)

{-| Split a list at the first element that matched the predicate.
    If the element was not found, apply the 'SplitFunction'.
-}
tripBy :: (a -> Bool) -> SplitFunction a b -> [a] -> b
tripBy p (onNo, onYes) xs = case break p xs of
    (before, []) -> onNo xs
    (before, x:after) -> onYes before x after

{-| As 'tripBy', but search from the end.
-}
revTripBy :: (a -> Bool) -> SplitFunction a b -> [a] -> b
revTripBy p (onNo, onYes) xs = case revBreak p xs of
    (before, []) -> onNo xs
    (before, after) -> onYes (init before) (last before) (after)

revBreak p xs = let (rAfter, rBefore) = break p (reverse xs)
                in if null rBefore
                    then (reverse rAfter, [])
                    else (reverse rBefore, reverse rAfter)

{-| Create a group around a found subnode and all following nodes.
    If no node was found, then there is no change.

    E.g
@
    (a b lambda x y z) ===> (a b (lambda x y z))
@
-}
addParens :: (Openable (h p), Hierarchy h p) => (h p a -> Bool) -> OpenAp (h p) a
addParens p = (id, tripBy p (id, onYes))
    where
    onYes before x after = before ++ [x `adjoinslPos` after]

{-| Add parenthesis around a found subnode and at most one following node.
    Associates to the right.
    If no node was found, then there is no change.

    E.g.
@
    (++ ++ x) ===> (++(++(x)))
@
-}
addShortParens :: (Openable (h p), Hierarchy h p) => (h p a -> Bool) -> h p a -> h p a
addShortParens p = openAp (id, tripBy p (id, onYes))
    where
    onYes before x [] = before++[x]
    onYes before x after' = case span p after' of
        ([], []) -> [x]
        (cont, []) -> before++[deepen (last cont) (reverse (x:init cont))]
        (cont, next:after) -> before ++ [deepen next (reverse (x:cont))] ++ after
        where
        deepen acc [] = acc
        deepen acc (x:xs) = deepen (x `adjoinPos` acc) xs


{-| Given an infix-detecting predicate, find the first matching subnode in the given node.
    Move the matching node to the front and wrap either side in new subnodes. If there is
    no matching subnode or either side is missing, the node is returned unchanged.

    E.g.
@
    (a b + c d + e f) ===> (+ (a b) (c d + e f))
@
-}
forwardInfix :: (Openable (h p), Hierarchy h p) => (h p a -> Bool) -> OpenAp (h p) a
forwardInfix p = (id, tripBy p (id, onYes))
    where
    onYes [] x after = x:after
    onYes before x [] = before++[x]
    onYes before x after = [x, adjoinsPos before, adjoinsPos after]

{-| Given an infix-detecting predicate, find the last matching subnode in the given node.
    Move the matching node to the front and wrap either side in new subnodes. If there is
    no matching subnode or either side is missing, the node is returned unchanged.

@
    (a b ** c d ** e f) ===> (** (a b ** c d) (e f))
@
-}
reverseInfix :: (Openable (h p), Hierarchy h p, Show (h p a)) => (h p a -> Bool) -> OpenAp (h p) a
reverseInfix p = (id, revTripBy p (id, onYes))
    where
    onYes [] x after = x:after
    onYes before x [] = before++[x]
    onYes before x after = [x, adjoinsPos before, adjoinsPos after]