----------------------------------------------------------------------------- -- | -- Module : Diagrams.Core.Compile -- Copyright : (c) 2013 diagrams-core team (see LICENSE) -- License : BSD-style (see LICENSE) -- Maintainer : diagrams-discuss@googlegroups.com -- -- This module provides tools for compiling @QDiagrams@ into a more -- convenient and optimized tree form, suitable for use by backends. -- ----------------------------------------------------------------------------- module Diagrams.Core.Compile ( -- * Tools for backends RNode(..) , RTree , toRTree -- * Internals , toDTree , fromDTree ) where import qualified Data.List.NonEmpty as NEL import Data.Maybe (fromMaybe) import Data.Monoid.Coproduct import Data.Monoid.MList import Data.Monoid.Split import Data.Semigroup import Data.Tree import Data.Tree.DUAL import Diagrams.Core.Transform import Diagrams.Core.Types emptyDTree :: Tree (DNode b v a) emptyDTree = Node DEmpty [] -- | Convert a @QDiagram@ into a raw tree. toDTree :: HasLinearMap v => QDiagram b v m -> Maybe (DTree b v Annotation) toDTree (QD qd) = foldDUAL -- Prims at the leaves. We ignore the accumulated d-annotations -- for prims (since we instead distribute them incrementally -- throughout the tree as they occur), or pass them to the -- continuation in the case of a delayed node. (\d -> withQDiaLeaf -- Prim: make a leaf node (\p -> Node (DPrim p) []) -- Delayed tree: pass the accumulated d-annotations to -- the continuation, convert the result to a DTree, and -- splice it in, adding a DDelay node to mark the point -- of the splice. (Node DDelay . (:[]) . fromMaybe emptyDTree . toDTree . ($d)) ) -- u-only leaves --> empty DTree. We don't care about the -- u-annotations. emptyDTree -- a non-empty list of child trees. (\ts -> case NEL.toList ts of [t] -> t ts' -> Node DEmpty ts' ) -- Internal d-annotations. We untangle the interleaved -- transformations and style, and carefully place the style -- /above/ the transform in the tree (since by calling -- 'untangle' we have already performed the action of the -- transform on the style). (\d t -> case get d of Option Nothing -> t Option (Just d') -> let (tr,sty) = untangle d' in Node (DStyle sty) [Node (DTransform tr) [t]] ) -- Internal a-annotations. (\a t -> Node (DAnnot a) [t]) qd -- | Convert a @DTree@ to an @RTree@ which can be used dirctly by backends. -- A @DTree@ includes nodes of type @DTransform (Split (Transformation v))@; -- in the @RTree@ the frozen part of the transform is put in a node of type -- @RFrozenTr (Transformation v)@ and the unfrozen part is pushed down until -- it is either frozen or reaches a primitive node. fromDTree :: HasLinearMap v => DTree b v Annotation -> RTree b v Annotation fromDTree = fromDTree' mempty where fromDTree' :: HasLinearMap v => Transformation v -> DTree b v Annotation -> RTree b v Annotation -- We put the accumulated unfrozen transformation (accTr) and the prim -- into an RPrim node. fromDTree' accTr (Node (DPrim p) _) = Node (RPrim accTr p) [] -- Styles are transformed then stored in their own node -- and accTr is push down the tree. fromDTree' accTr (Node (DStyle s) ts) = Node (RStyle (transform accTr s)) (fmap (fromDTree' accTr) ts) -- Unfrozen transformations are accumulated and pushed down as well. fromDTree' accTr (Node (DTransform (M tr)) ts) = Node REmpty (fmap (fromDTree' (accTr <> tr)) ts) -- Frozen transformations are stored in the RFrozenTr node -- and accTr is reset to the unfrozen part of the transform. fromDTree' accTr (Node (DTransform (tr1 :| tr2)) ts) = Node (RFrozenTr (accTr <> tr1)) (fmap (fromDTree' tr2) ts) fromDTree' accTr (Node (DAnnot a) ts) = Node (RAnnot a) (fmap (fromDTree' accTr) ts) -- Drop accumulated transformations upon encountering a DDelay -- node --- the tree unfolded beneath it already took into account -- any non-frozen transformation at this point. fromDTree' _ (Node DDelay ts) = Node REmpty (fmap (fromDTree' mempty) ts) -- DEmpty nodes become REmpties, again accTr flows through. fromDTree' accTr (Node _ ts) = Node REmpty (fmap (fromDTree' accTr) ts) -- | Compile a @QDiagram@ into an 'RTree'. Suitable for use by -- backends when implementing 'renderData'. toRTree :: HasLinearMap v => QDiagram b v m -> RTree b v Annotation toRTree = fromDTree . fromMaybe (Node DEmpty []) . toDTree