never executed always true always false

    1 {-|
    2 Copyright   : Written by David Himmelstrup
    3 License     : Unlicense
    4 Maintainer  : lemmih@gmail.com
    5 Stability   : experimental
    6 Portability : POSIX
    7 -}
    8 module Reanimate.Svg.Unuse
    9   ( replaceUses
   10   , unbox
   11   , embedDocument
   12   ) where
   13 
   14 import           Control.Lens               ((%~), (&), (.~), (?~), (^.))
   15 import qualified Data.Map                   as Map
   16 import           Data.Maybe
   17 import           Graphics.SvgTree
   18 import           Reanimate.Constants
   19 import           Reanimate.Svg.Constructors
   20 
   21 -- | Replace all @<use>@ nodes with their definition.
   22 replaceUses :: Document -> Document
   23 replaceUses doc = doc & documentElements %~ map (mapTree replace)
   24   where
   25     replaceDefinition PathTree{} = None
   26     replaceDefinition t          = t
   27 
   28     replace t@DefinitionTree{} = mapTree replaceDefinition t
   29     replace (UseTree _ Just{}) = error "replaceUses: subtree in use?"
   30     replace (UseTree use Nothing) =
   31       case Map.lookup (use^.useName) idMap of
   32         Nothing -> error $ "Unknown id: " ++ (use^.useName)
   33         Just tree -> mapTree replace $
   34           groupTree (defaultSvg & groupChildren .~ [tree])
   35           & transform ?~
   36               fromMaybe [] (use^.transform) ++
   37               [baseToTransformation (use^.useBase)]
   38     replace x = x
   39     baseToTransformation (x,y) =
   40       case (toUserUnit defaultDPI x, toUserUnit defaultDPI y) of
   41         (Num a, Num b) -> Translate a b
   42         _              -> TransformUnknown
   43     docTree = mkGroup (doc^.documentElements)
   44     idMap = foldTree updMap Map.empty docTree
   45     updMap m tree =
   46       case tree^.attrId of
   47         Nothing  -> m
   48         Just tid -> Map.insert tid tree m
   49 
   50 -- FIXME: the viewbox is ignored. Can we use the viewbox as a mask?
   51 -- | Transform out viewbox. Definitions and CSS rules are discarded.
   52 unbox :: Document -> Tree
   53 unbox doc@Document{_documentViewBox = Just (_minx, _minw, _width, _height)} =
   54   groupTree $ defaultSvg
   55           & groupChildren .~ doc^.documentElements
   56 unbox doc =
   57   groupTree $ defaultSvg
   58     & groupChildren .~ doc^.documentElements
   59 
   60 -- | Embed 'Document'. This keeps the entire document intact but makes
   61 --   it more difficult to use, say, `Reanimate.Svg.pathify` on it.
   62 embedDocument :: Document -> Tree
   63 embedDocument doc =
   64   translate (-screenWidth/2) (screenHeight/2) $
   65   withFillOpacity 1 $
   66   withStrokeWidth 0 $
   67   flipYAxis $
   68   svgTree $ doc & documentWidth .~ Nothing
   69                 & documentHeight .~ Nothing