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
" "