{-|
Description : Trees with unique labels
-}
module Language.Haskell.Formatter.Internal.MapTree
       (MapTree(..), MapForest, isEmpty, summarizeLeaves, indentTree) where
import qualified Control.Applicative as Applicative
import qualified Data.Map.Strict as Map
import qualified Data.Monoid as Monoid
import qualified Language.Haskell.Formatter.Internal.Newline as Newline

data MapTree k a = Leaf a
                 | Node (MapForest k a)
                     deriving (MapTree k a -> MapTree k a -> Bool
(MapTree k a -> MapTree k a -> Bool)
-> (MapTree k a -> MapTree k a -> Bool) -> Eq (MapTree k a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k a. (Eq a, Eq k) => MapTree k a -> MapTree k a -> Bool
/= :: MapTree k a -> MapTree k a -> Bool
$c/= :: forall k a. (Eq a, Eq k) => MapTree k a -> MapTree k a -> Bool
== :: MapTree k a -> MapTree k a -> Bool
$c== :: forall k a. (Eq a, Eq k) => MapTree k a -> MapTree k a -> Bool
Eq, Eq (MapTree k a)
Eq (MapTree k a)
-> (MapTree k a -> MapTree k a -> Ordering)
-> (MapTree k a -> MapTree k a -> Bool)
-> (MapTree k a -> MapTree k a -> Bool)
-> (MapTree k a -> MapTree k a -> Bool)
-> (MapTree k a -> MapTree k a -> Bool)
-> (MapTree k a -> MapTree k a -> MapTree k a)
-> (MapTree k a -> MapTree k a -> MapTree k a)
-> Ord (MapTree k a)
MapTree k a -> MapTree k a -> Bool
MapTree k a -> MapTree k a -> Ordering
MapTree k a -> MapTree k a -> MapTree k a
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
forall k a. (Ord a, Ord k) => Eq (MapTree k a)
forall k a. (Ord a, Ord k) => MapTree k a -> MapTree k a -> Bool
forall k a.
(Ord a, Ord k) =>
MapTree k a -> MapTree k a -> Ordering
forall k a.
(Ord a, Ord k) =>
MapTree k a -> MapTree k a -> MapTree k a
min :: MapTree k a -> MapTree k a -> MapTree k a
$cmin :: forall k a.
(Ord a, Ord k) =>
MapTree k a -> MapTree k a -> MapTree k a
max :: MapTree k a -> MapTree k a -> MapTree k a
$cmax :: forall k a.
(Ord a, Ord k) =>
MapTree k a -> MapTree k a -> MapTree k a
>= :: MapTree k a -> MapTree k a -> Bool
$c>= :: forall k a. (Ord a, Ord k) => MapTree k a -> MapTree k a -> Bool
> :: MapTree k a -> MapTree k a -> Bool
$c> :: forall k a. (Ord a, Ord k) => MapTree k a -> MapTree k a -> Bool
<= :: MapTree k a -> MapTree k a -> Bool
$c<= :: forall k a. (Ord a, Ord k) => MapTree k a -> MapTree k a -> Bool
< :: MapTree k a -> MapTree k a -> Bool
$c< :: forall k a. (Ord a, Ord k) => MapTree k a -> MapTree k a -> Bool
compare :: MapTree k a -> MapTree k a -> Ordering
$ccompare :: forall k a.
(Ord a, Ord k) =>
MapTree k a -> MapTree k a -> Ordering
$cp1Ord :: forall k a. (Ord a, Ord k) => Eq (MapTree k a)
Ord, Int -> MapTree k a -> ShowS
[MapTree k a] -> ShowS
MapTree k a -> String
(Int -> MapTree k a -> ShowS)
-> (MapTree k a -> String)
-> ([MapTree k a] -> ShowS)
-> Show (MapTree k a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k a. (Show a, Show k) => Int -> MapTree k a -> ShowS
forall k a. (Show a, Show k) => [MapTree k a] -> ShowS
forall k a. (Show a, Show k) => MapTree k a -> String
showList :: [MapTree k a] -> ShowS
$cshowList :: forall k a. (Show a, Show k) => [MapTree k a] -> ShowS
show :: MapTree k a -> String
$cshow :: forall k a. (Show a, Show k) => MapTree k a -> String
showsPrec :: Int -> MapTree k a -> ShowS
$cshowsPrec :: forall k a. (Show a, Show k) => Int -> MapTree k a -> ShowS
Show)

type MapForest k a = Map.Map k (MapTree k a)

instance Functor (MapTree k) where
        fmap :: (a -> b) -> MapTree k a -> MapTree k b
fmap a -> b
function (Leaf a
value) = b -> MapTree k b
forall k a. a -> MapTree k a
Leaf (b -> MapTree k b) -> b -> MapTree k b
forall a b. (a -> b) -> a -> b
$ a -> b
function a
value
        fmap a -> b
function (Node MapForest k a
forest) = MapForest k b -> MapTree k b
forall k a. MapForest k a -> MapTree k a
Node (MapForest k b -> MapTree k b) -> MapForest k b -> MapTree k b
forall a b. (a -> b) -> a -> b
$ (MapTree k a -> MapTree k b) -> MapForest k a -> MapForest k b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> MapTree k a -> MapTree k b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
function) MapForest k a
forest

isEmpty :: MapTree k a -> Bool
isEmpty :: MapTree k a -> Bool
isEmpty (Leaf a
_) = Bool
False
isEmpty (Node MapForest k a
forest) = MapForest k a -> Bool
forall k a. Map k a -> Bool
Map.null MapForest k a
forest

summarizeLeaves ::
                  (Ord k, Monoid.Monoid b) =>
                  MapForest k (Either a b) -> MapTree k (Either a (Map.Map k b))
summarizeLeaves :: MapForest k (Either a b) -> MapTree k (Either a (Map k b))
summarizeLeaves = Map k b
-> MapForest k (Either a b) -> MapTree k (Either a (Map k b))
forall k c a.
(Ord k, Monoid c) =>
Map k c
-> MapForest k (Either a c) -> MapTree k (Either a (Map k c))
summarize Map k b
forall k a. Map k a
Map.empty
  where summarize :: Map k c
-> MapForest k (Either a c) -> MapTree k (Either a (Map k c))
summarize Map k c
labels MapForest k (Either a c)
root
          = if Map k a -> Bool
forall k a. Map k a -> Bool
Map.null Map k a
lefts then
              if Map k (MapForest k (Either a c)) -> Bool
forall k a. Map k a -> Bool
Map.null Map k (MapForest k (Either a c))
forests then Either a (Map k c) -> MapTree k (Either a (Map k c))
forall k a. a -> MapTree k a
Leaf (Either a (Map k c) -> MapTree k (Either a (Map k c)))
-> (Map k c -> Either a (Map k c))
-> Map k c
-> MapTree k (Either a (Map k c))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map k c -> Either a (Map k c)
forall a b. b -> Either a b
Right (Map k c -> MapTree k (Either a (Map k c)))
-> Map k c -> MapTree k (Either a (Map k c))
forall a b. (a -> b) -> a -> b
$ Map k c
labels' else
                (MapForest k (Either a c) -> MapTree k (Either a (Map k c)))
-> Map k (MapForest k (Either a c))
-> MapTree k (Either a (Map k c))
forall a k a. (a -> MapTree k a) -> Map k a -> MapTree k a
fromMap (Map k c
-> MapForest k (Either a c) -> MapTree k (Either a (Map k c))
summarize Map k c
labels') Map k (MapForest k (Either a c))
forests
              else (a -> MapTree k (Either a (Map k c)))
-> Map k a -> MapTree k (Either a (Map k c))
forall a k a. (a -> MapTree k a) -> Map k a -> MapTree k a
fromMap (Either a (Map k c) -> MapTree k (Either a (Map k c))
forall k a. a -> MapTree k a
Leaf (Either a (Map k c) -> MapTree k (Either a (Map k c)))
-> (a -> Either a (Map k c)) -> a -> MapTree k (Either a (Map k c))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either a (Map k c)
forall a b. a -> Either a b
Left) Map k a
lefts
          where (Map k a
lefts, Map k c
rights) = (Either a c -> Either a c)
-> Map k (Either a c) -> (Map k a, Map k c)
forall a b c k. (a -> Either b c) -> Map k a -> (Map k b, Map k c)
Map.mapEither Either a c -> Either a c
forall a. a -> a
id Map k (Either a c)
values
                (Map k (Either a c)
values, Map k (MapForest k (Either a c))
forests) = (MapTree k (Either a c)
 -> Either (Either a c) (MapForest k (Either a c)))
-> MapForest k (Either a c)
-> (Map k (Either a c), Map k (MapForest k (Either a c)))
forall a b c k. (a -> Either b c) -> Map k a -> (Map k b, Map k c)
Map.mapEither MapTree k (Either a c)
-> Either (Either a c) (MapForest k (Either a c))
forall k a. MapTree k a -> Either a (MapForest k a)
distinguish MapForest k (Either a c)
root
                distinguish :: MapTree k a -> Either a (MapForest k a)
distinguish (Leaf a
value) = a -> Either a (MapForest k a)
forall a b. a -> Either a b
Left a
value
                distinguish (Node MapForest k a
forest) = MapForest k a -> Either a (MapForest k a)
forall a b. b -> Either a b
Right MapForest k a
forest
                labels' :: Map k c
labels' = (c -> c -> c) -> Map k c -> Map k c -> Map k c
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith c -> c -> c
forall a. Monoid a => a -> a -> a
Monoid.mappend Map k c
labels Map k c
rights
                fromMap :: (a -> MapTree k a) -> Map k a -> MapTree k a
fromMap a -> MapTree k a
function = MapForest k a -> MapTree k a
forall k a. MapForest k a -> MapTree k a
Node (MapForest k a -> MapTree k a)
-> (Map k a -> MapForest k a) -> Map k a -> MapTree k a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> MapTree k a) -> Map k a -> MapForest k a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> MapTree k a
function

indentTree :: MapTree String String -> String
indentTree :: MapTree String String -> String
indentTree = [String] -> String
Newline.joinSeparatedLines ([String] -> String)
-> (MapTree String String -> [String])
-> MapTree String String
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MapTree String String -> [String]
indentLines
  where indentLines :: MapTree String String -> [String]
indentLines (Leaf String
value) = String -> [String]
Newline.splitSeparatedLines String
value
        indentLines (Node MapForest String String
forest) = (String -> MapTree String String -> [String])
-> MapForest String String -> [String]
forall a b b. (a -> b -> [b]) -> Map a b -> [b]
foldMapWithKey String -> MapTree String String -> [String]
indentBinding MapForest String String
forest
        foldMapWithKey :: (a -> b -> [b]) -> Map a b -> [b]
foldMapWithKey a -> b -> [b]
create = ([(a, b)] -> ((a, b) -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (a -> b -> [b]) -> (a, b) -> [b]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> b -> [b]
create) ([(a, b)] -> [b]) -> (Map a b -> [(a, b)]) -> Map a b -> [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map a b -> [(a, b)]
forall k a. Map k a -> [(k, a)]
Map.toAscList
        indentBinding :: String -> MapTree String String -> [String]
indentBinding String
label MapTree String String
tree = [String] -> [String] -> [String]
forall a. Monoid a => a -> a -> a
Monoid.mappend [String]
labelLines [String]
treeLines
          where labelLines :: [String]
labelLines = String -> [String]
Newline.splitSeparatedLines String
label
                treeLines :: [String]
treeLines = ShowS
indent ShowS -> [String] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Applicative.<$> MapTree String String -> [String]
indentLines MapTree String String
tree
        indent :: ShowS
indent = (String
indentation String -> ShowS
forall a. [a] -> [a] -> [a]
++)
        indentation :: String
indentation = String
"    "