reflex-dom-svg (empty) → 0.3.2.0
raw patch · 19 files changed
+1452/−0 lines, 19 filesdep +basedep +containersdep +lenssetup-changed
Dependencies added: base, containers, lens, reflex, reflex-dom-core, safe, text
Files
- LICENCE +31/−0
- README.md +73/−0
- Setup.hs +2/−0
- changelog.md +25/−0
- reflex-dom-svg.cabal +47/−0
- src/Reflex/Dom/Widget/SVG.hs +179/−0
- src/Reflex/Dom/Widget/SVG/Types.hs +138/−0
- src/Reflex/Dom/Widget/SVG/Types/CornerRadius.hs +34/−0
- src/Reflex/Dom/Widget/SVG/Types/Internal.hs +67/−0
- src/Reflex/Dom/Widget/SVG/Types/Pos.hs +82/−0
- src/Reflex/Dom/Widget/SVG/Types/Radius.hs +40/−0
- src/Reflex/Dom/Widget/SVG/Types/SVG_Animate.hs +139/−0
- src/Reflex/Dom/Widget/SVG/Types/SVG_Circle.hs +57/−0
- src/Reflex/Dom/Widget/SVG/Types/SVG_Ellipse.hs +65/−0
- src/Reflex/Dom/Widget/SVG/Types/SVG_Line.hs +49/−0
- src/Reflex/Dom/Widget/SVG/Types/SVG_Path.hs +237/−0
- src/Reflex/Dom/Widget/SVG/Types/SVG_PolyLine.hs +52/−0
- src/Reflex/Dom/Widget/SVG/Types/SVG_Polygon.hs +47/−0
- src/Reflex/Dom/Widget/SVG/Types/SVG_Rect.hs +88/−0
+ LICENCE view
@@ -0,0 +1,31 @@+Copyright (c) 2018, Commonwealth Scientific and Industrial Research Organisation+(CSIRO) ABN 41 687 119 230.++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of QFPL nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,73 @@+<img src="http://i.imgur.com/0h9dFhl.png" width="300px"/>++# Reflex Dom SVG Helper++A helper library for working with SVG and creating dynamic SVG images using+[reflex-dom](https://github.com/reflex-frp/reflex-dom). This library provides+a pile of types and some helper functions to make the process of creating and+managing your SVG elements, more type safe and a bit easier.++It currently supports the following SVG elements/properties:++* rect+* circle+* polygon+* polyline+* ellipse+* line+* animate+* path (included is an API for building type safe paths)++The SVG elements are designed to be created inside a SVG root element:++```haskell+let dSVGEl = pure $ SVG_El (Width 600.0) (Height 400)+a <- svg_ dSVGEl $ do+ ... -- other SVG elements go in here+```++Each of the SVG elements this library supports has a properties type+associated with it, similar to how the ``TextInput`` and other widget types+are configured in the core ``reflex-dom`` library.++```haskell+data SVG_Rect = SVG_Rect+ { _svg_rect_pos_x :: Pos X+ , _svg_rect_pos_y :: Pos Y+ , _svg_rect_width :: Width+ , _svg_rect_height :: Height+ , _svg_rect_cornerRadius_x :: Maybe (CornerRadius X)+ , _svg_rect_cornerRadius_y :: Maybe (CornerRadius Y)+ }+```++The respective module contains a function to take these properties and+convert them into the ``Map Text Text`` format that is expected by+``reflex-dom``. The functions in this module take care of this for you, and+allow you to add any other attributes as you require. You are able to manage+the properties of an SVG element as either a static input or a ``Dynamic``.++Additionally there is a (still work-in-progress) API for type safe ``<path>``+construction in the ``Reflex.Dom.Widget.SVG.Types.SVG_Path`` module. The+``SVG_Path`` type is a ``newtype`` over a ``NonEmpty PathCommand``, which+prevents you from having an empty list of Path instructions. As a minimal+example of using the API as it currently is:++```haskell+-- Drawing a simple rectangle using a <path>+r :: SVG_Path+r = _Wrapped # NonEmpty.fromList+ [ _M (_PosX # 10.0) (_PosY # 10.0)+ , _H (_PosX # 90.0)+ , _V (_PosY # 90.0)+ , _H (_PosX # 10.0)+ , _L (_PosX # 10.0) (_PosY # 10.0)+ ]+```++The functions ``_M``, ``_H``, ``_L``, and ``_V``, all correspond to their+``<path>`` commands from the [MDN Documentation on+Paths](https://developer.mozilla.org/en-US/docs/Web/SVG/Tutorial/Paths).+These are the non-relative variants of those commands, there are relative+versions as well, which are just lower-case named functions of the same type:+``_m``, ``_h``, and so on.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ changelog.md view
@@ -0,0 +1,25 @@+0.3.2.0++* Bumped reflex-platform +* Added 'example' project+* Fix issue that prevented 'animate' attributes from rendering correctly+* Fix 'ellipse' 'cy' property+* Fix 'circle' 'radius' type and add an example to the Example file.+* Update the Example.lhs to work with latest changes+* Remove the shell.nix+* Update default.nix to use 'shellAware' function+* Update element types to more general 'Element' type+* Remove image from cabal file, add readme to extra-source-files++0.2.0.0++* Add "viewBox" property support for root SVG tag. This breaks existing SVG_El definitions.+* Expose the 'raw' svg drawing functions.+* Update default.nix to not try to generate haddocks on GHCJS build. Would cause the build to fail.+* Add a helper function to change the indexed type of a Pos.++0.1.1.0++* First version. Released on an unsuspecting world.+* Add import for SVG_Circle+* Update the props functions to correctly update the attribute map
+ reflex-dom-svg.cabal view
@@ -0,0 +1,47 @@+name: reflex-dom-svg+version: 0.3.2.0+synopsis: Reflex functions for SVG elements.+description: Provides support for easily creating and manipulating SVG elements via Reflex.+license: BSD3+license-file: LICENCE+author: Queensland Functional Programming Lab <oᴉ˙ldɟb@llǝʞsɐɥ>+maintainer: Queensland Functional Programming Lab <oᴉ˙ldɟb@llǝʞsɐɥ>+copyright: Copyright (c) 2018, Commonwealth Scientific and Industrial Research Organisation (CSIRO) ABN 41 687 119 230.+category: FRP,Web,Graphics+build-type: Simple+extra-source-files: changelog.md, README.md+cabal-version: 1.24++source-repository head+ type: git+ location: git@github.com/qfpl/reflex-dom-svg/reflex-dom-svg.git++library+ ghc-options: -Wall++ exposed-modules: Reflex.Dom.Widget.SVG+ , Reflex.Dom.Widget.SVG.Types+ , Reflex.Dom.Widget.SVG.Types.Internal+ , Reflex.Dom.Widget.SVG.Types.Pos+ , Reflex.Dom.Widget.SVG.Types.CornerRadius+ , Reflex.Dom.Widget.SVG.Types.Radius+ , Reflex.Dom.Widget.SVG.Types.SVG_Path+ , Reflex.Dom.Widget.SVG.Types.SVG_Rect+ , Reflex.Dom.Widget.SVG.Types.SVG_Circle+ , Reflex.Dom.Widget.SVG.Types.SVG_Ellipse+ , Reflex.Dom.Widget.SVG.Types.SVG_Line+ , Reflex.Dom.Widget.SVG.Types.SVG_Polygon+ , Reflex.Dom.Widget.SVG.Types.SVG_PolyLine+ , Reflex.Dom.Widget.SVG.Types.SVG_Animate++ build-depends: base >=4.9 && <=4.12+ , text >= 1.2 && < 1.3+ , reflex >= 0.4 && < 0.7+ , reflex-dom-core >= 0.5 && < 0.7+ , lens >= 4.16.1 && < 4.17+ , containers == 0.5.*+ , safe == 0.3.*++ hs-source-dirs: src++ default-language: Haskell2010
+ src/Reflex/Dom/Widget/SVG.hs view
@@ -0,0 +1,179 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+-- | Main functions for creating SVG dom elements via Reflex+module Reflex.Dom.Widget.SVG+ ( AsSVGTag (..)+ , BasicSVG (..)+ , BasicInner (..)+ , SVG_Root (..)+ , CanBeNested+ , SVGEl (..)+ , svg_+ , svgBasicDyn+ , svgBasicDyn_+ , svgElDynAttr'+ , svgElDynAttr_+ ) where++import Control.Monad.Fix (MonadFix)+import Data.Text (Text)++import Reflex (Dynamic, MonadHold) +import qualified Reflex as R++import Reflex.Dom.Core (Element, EventResult, DomBuilderSpace, DomBuilder, PostBuild)+import qualified Reflex.Dom.Core as RD++import Data.Map (Map)++import Reflex.Dom.Widget.SVG.Types (SVG_El, makeSVGProps)++-- | Lawless class to provide a constraint indicating that a given type is capable+-- of being represented by a SVG XML Tag. <rect>, <circle>, <svg>, etc.+class AsSVGTag s where+ svgTagName :: s -> Text++instance AsSVGTag BasicSVG where+ svgTagName Rectangle = "rect"+ svgTagName Circle = "circle"+ svgTagName Ellipse = "ellipse"+ svgTagName Path = "path"+ svgTagName Line = "line"+ svgTagName PolyLine = "polyline"+ svgTagName Polygon = "polygon"++instance AsSVGTag BasicInner where+ svgTagName Animate = "animate"++instance AsSVGTag SVG_Root where+ svgTagName SVG_Root = "svg"++-- | The SVG Root element: "<svg>"+data SVG_Root = SVG_Root++-- | The basic SVG shapes.+data BasicSVG+ = Rectangle+ | Circle+ | Ellipse+ | Path+ | Line+ | PolyLine+ | Polygon+ deriving (Show, Eq)++-- | The simplest inner element for a basic shape, the "<animate>" tag.+data BasicInner+ = Animate+ deriving (Eq, Ord)++-- | Create a relationship between a set of SVG tags that can be nested inside a+-- different set of SVG tags. Currently this just creates the relationship+-- between the "<animate>" tag and the basic shapes ("<rect>", "<circle>", etc).+type family CanBeNested a :: *+type instance CanBeNested BasicSVG = BasicInner++-- | This represents an SVG element, containing both the raw Reflex.Dom @El@ type+-- and a @Dynamic@ of all of the children that are nested in this element.+data SVGEl t m a = SVGEl+ { _svgEl_el :: Element EventResult (DomBuilderSpace m) t+ , _svgEl_children :: Dynamic t (Map (CanBeNested a) (Element EventResult (DomBuilderSpace m) t))+ }++svgXMLNamespace :: Text+svgXMLNamespace = "http://www.w3.org/2000/svg"++-- | This is for creating a SVG element with @Dynamic@ attributes, and ensuring we+-- use the right namespace so the browser actually picks up on it. The name+-- space in use is "http://www.w3.org/2000/svg".+svgElDynAttr'+ :: forall t m a e. ( DomBuilder t m+ , PostBuild t m+ , AsSVGTag e+ )+ => e+ -> Dynamic t (Map Text Text)+ -> m a+ -> m (Element EventResult (DomBuilderSpace m) t, a)+svgElDynAttr' = RD.elDynAttrNS'+ (Just svgXMLNamespace)+ . svgTagName++-- | As per @svgElDynAttr'@, but does not have any children.+svgElDynAttr_+ :: forall t m e. ( DomBuilder t m+ , PostBuild t m+ , AsSVGTag e+ )+ => e+ -> Dynamic t (Map Text Text)+ -> m (Element EventResult (DomBuilderSpace m) t)+svgElDynAttr_ t dAttrs = fst <$> RD.elDynAttrNS'+ (Just svgXMLNamespace)+ (svgTagName t)+ dAttrs+ RD.blank++-- | Create the Root SVG element.+--+-- Note that there are not restrictions on the inner element, apart from the+-- return type being of @m (SVGEl t a)@. So you are free to place whatever you+-- like in there, but bear in mind that the browser rules for SVG are still in+-- play. So text inputs etc, won't work.+svg_+ :: ( DomBuilder t m+ , PostBuild t m+ , R.Reflex t+ , AsSVGTag a+ )+ => Dynamic t SVG_El+ -> m ( SVGEl t m a )+ -> m ( Element EventResult (DomBuilderSpace m) t, SVGEl t m a)+svg_ dAttrs =+ svgElDynAttr' SVG_Root (makeSVGProps <$> dAttrs)++-- | Create a SVG element that has dynamic attributes and contains children that+-- are acceptable children for this element. "<rect>" as a Basic Shape can only+-- contain "<animate>" elements, for example.+--+-- The SVG element will have some @Dynamic@ properties and a function that+-- allows these properties to be converted into a @Map Text Text@, inline with+-- other Reflex.Dom widgets.+svgBasicDyn+ :: ( DomBuilder t m+ , PostBuild t m+ , MonadFix m + , MonadHold t m+ , AsSVGTag s+ , AsSVGTag (CanBeNested s)+ , Ord (CanBeNested s)+ )+ => s+ -> ( p -> Map Text Text )+ -> Dynamic t p+ -> Dynamic t ( Map (CanBeNested s) (Map Text Text) )+ -> m ( SVGEl t m s )+svgBasicDyn t propFn dProps dInnerElMap =+ fmap ( uncurry SVGEl ) . svgElDynAttr' t (propFn <$> dProps) $ RD.listWithKey dInnerElMap+ (\innerS dInnerAttrs -> fst <$> svgElDynAttr' innerS dInnerAttrs RD.blank)++-- | As per the @svgBasicDyn@ function, except with no inner elements.+svgBasicDyn_+ :: ( DomBuilder t m+ , PostBuild t m+ , MonadFix m+ , MonadHold t m+ , AsSVGTag s+ , AsSVGTag (CanBeNested s)+ , Ord (CanBeNested s)+ )+ => s+ -> ( p -> Map Text Text )+ -> Dynamic t p+ -> m ( SVGEl t m s )+svgBasicDyn_ t propFn dProps =+ svgBasicDyn t propFn dProps (pure mempty)
+ src/Reflex/Dom/Widget/SVG/Types.hs view
@@ -0,0 +1,138 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeFamilies #-}+-- | Contains the root \<svg\> element properties and re-exports all of the individual SVG Types+module Reflex.Dom.Widget.SVG.Types+ ( SVG_El (..)+ , ViewBox (..)+ , svg_root_width+ , svg_root_height+ , svg_root_viewbox+ , viewBox_height+ , viewBox_width+ , viewBox_min_x+ , viewBox_min_y++ , makeSVGProps+ , makeViewBox++ , module Reflex.Dom.Widget.SVG.Types.Internal++ , module Reflex.Dom.Widget.SVG.Types.CornerRadius+ , module Reflex.Dom.Widget.SVG.Types.Pos+ , module Reflex.Dom.Widget.SVG.Types.Radius++ , module Reflex.Dom.Widget.SVG.Types.SVG_Animate+ , module Reflex.Dom.Widget.SVG.Types.SVG_Circle+ , module Reflex.Dom.Widget.SVG.Types.SVG_Ellipse+ , module Reflex.Dom.Widget.SVG.Types.SVG_Line+ , module Reflex.Dom.Widget.SVG.Types.SVG_Polygon+ , module Reflex.Dom.Widget.SVG.Types.SVG_PolyLine+ , module Reflex.Dom.Widget.SVG.Types.SVG_Rect+ , module Reflex.Dom.Widget.SVG.Types.SVG_Path+ )+ where++import Control.Lens (Lens', at, to, (.~),+ (^.), (^?), _Just,+ _Wrapped)++import Data.Function ((&))++import Data.Text (Text)+import qualified Data.Text as Text++import Data.Map (Map)+import qualified Data.Map as Map++import Reflex.Dom.Widget.SVG.Types.Internal++import Reflex.Dom.Widget.SVG.Types.SVG_Path++import Reflex.Dom.Widget.SVG.Types.CornerRadius+import Reflex.Dom.Widget.SVG.Types.Pos+import Reflex.Dom.Widget.SVG.Types.Radius++import Reflex.Dom.Widget.SVG.Types.SVG_Animate+import Reflex.Dom.Widget.SVG.Types.SVG_Circle+import Reflex.Dom.Widget.SVG.Types.SVG_Ellipse+import Reflex.Dom.Widget.SVG.Types.SVG_Line+import Reflex.Dom.Widget.SVG.Types.SVG_Polygon+import Reflex.Dom.Widget.SVG.Types.SVG_PolyLine+import Reflex.Dom.Widget.SVG.Types.SVG_Rect++-- | SVG @viewBox@ attribute+data ViewBox = ViewBox+ { _viewBox_min_X :: Float+ , _viewBox_min_Y :: Float+ , _viewBox_width :: Width+ , _viewBox_height :: Height+ }+ deriving (Eq, Show)++-- | Lens for @_viewBox_min_X@ attribute on @ViewBox@+viewBox_min_x :: Lens' ViewBox Float+viewBox_min_x f (ViewBox minX minY w h) = fmap (\minX' -> ViewBox minX' minY w h) (f minX)+{-# INLINE viewBox_min_x #-}++-- | Lens for @_viewBox_min_Y@ attribute on @ViewBox@+viewBox_min_y :: Lens' ViewBox Float+viewBox_min_y f (ViewBox minX minY w h) = fmap (\minY' -> ViewBox minX minY' w h) (f minY)+{-# INLINE viewBox_min_y #-}++-- | Lens for @_viewBox_width@ attribute on @ViewBox@+viewBox_width :: Lens' ViewBox Width+viewBox_width f (ViewBox minX minY w h) = fmap (\w' -> ViewBox minX minY w' h) (f w)+{-# INLINE viewBox_width #-}++-- | Lens for @_viewBox_min_X@ attribute on @ViewBox@+viewBox_height :: Lens' ViewBox Height+viewBox_height f (ViewBox minX minY w h) = fmap (ViewBox minX minY w) (f h)+{-# INLINE viewBox_height #-}++-- | Minimum information required for building a SVG root element.+data SVG_El = SVG_El+ { _svg_root_width :: Width+ , _svg_root_height :: Height+ , _svg_view_box :: Maybe ViewBox+ }+ deriving (Eq, Show)++-- | Lens for @Height@ attribute on @SVG_El@+svg_root_height :: Lens' SVG_El Height+svg_root_height f (SVG_El x1 x2 v) = fmap (\x2' -> SVG_El x1 x2' v) (f x2)+{-# INLINE svg_root_height #-}++-- | Lens for @Width@ attribute on @SVG_El@+svg_root_width :: Lens' SVG_El Width+svg_root_width f (SVG_El x1 x2 v) = fmap (\x1' -> SVG_El x1' x2 v) (f x1)+{-# INLINE svg_root_width #-}++-- | Lens for @ViewBox@ attribute on @SVG_El@+svg_root_viewbox :: Lens' SVG_El ( Maybe ViewBox )+svg_root_viewbox f (SVG_El x1 x2 v) = fmap (SVG_El x1 x2) (f v)+{-# INLINE svg_root_viewbox #-}++makeViewBox+ :: ViewBox+ -> Text+makeViewBox ViewBox {..} = Text.unwords $ Text.pack . show <$>+ [ _viewBox_min_X+ , _viewBox_min_Y+ , _viewBox_width ^. _Wrapped+ , _viewBox_height ^. _Wrapped+ ]++-- | Convert the record to the correct attribute map for Reflex.+makeSVGProps+ :: SVG_El+ -> Map Text Text+makeSVGProps s = Map.fromList+ [ ("width", s ^. svg_root_width . wrappedToText )+ , ("height", s ^. svg_root_height . wrappedToText )+ , ("xmlns", "http://www.w3.org/2000/svg" )+ ]+ & at "viewBox" .~ s ^? svg_root_viewbox . _Just . to makeViewBox
+ src/Reflex/Dom/Widget/SVG/Types/CornerRadius.hs view
@@ -0,0 +1,34 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies #-}+-- | Types and functions for a corner radius+module Reflex.Dom.Widget.SVG.Types.CornerRadius+ ( CornerRadius+ , _CornerRadiusX+ , _CornerRadiusY+ ) where++import Control.Lens (Iso', Rewrapped, Wrapped (..),+ iso, _Wrapped)++import Reflex.Dom.Widget.SVG.Types.Pos (X, Y)++-- | Corner Radius is effectively just a @Float@, but we can do better.+newtype CornerRadius p =+ CornerRadius Float+ deriving (Eq, Show)++instance (CornerRadius p) ~ t => Rewrapped (CornerRadius p) t++instance Wrapped (CornerRadius p) where+ type Unwrapped (CornerRadius p) = Float+ _Wrapped' = iso (\(CornerRadius x) -> x) CornerRadius++-- | @Iso@ for the CornerRadius on the X axis+_CornerRadiusX :: Iso' (CornerRadius X) Float+_CornerRadiusX = _Wrapped++-- | @Iso@ for the CornerRadius on the Y axis+_CornerRadiusY :: Iso' (CornerRadius Y) Float+_CornerRadiusY = _Wrapped
+ src/Reflex/Dom/Widget/SVG/Types/Internal.hs view
@@ -0,0 +1,67 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies #-}+-- | Miscellaneous types and functions of the API. This module is named Internal+-- as it is possible it will change.+module Reflex.Dom.Widget.SVG.Types.Internal+ ( Width (..)+ , Height (..)+ , AttributeName (..)+ , RepeatCount (..)+ , wrappedToText+ ) where++import Control.Lens (Contravariant, Rewrapped, Wrapped (..), iso,+ to, _Wrapped)++import Data.Text (Text)+import Data.Text.Lens (IsText, packed)++-- | Wrap the @Float@ value with something more meaningful.+newtype Width = Width Float deriving (Eq, Show)+-- | Wrap the @Float@ value with something more meaningful.+newtype Height = Height Float deriving (Eq, Show)+-- | Wrap the @Text@ value with something more meaningful.+newtype AttributeName = AttributeName Text deriving (Eq, Show)++instance Width ~ t => Rewrapped Width t+instance Wrapped Width where+ type Unwrapped Width = Float+ _Wrapped' = iso (\(Width x) -> x) Width++instance Height ~ t => Rewrapped Height t+instance Wrapped Height where+ type Unwrapped Height = Float+ _Wrapped' = iso (\(Height x) -> x) Height++instance AttributeName ~ t => Rewrapped AttributeName t+instance Wrapped AttributeName where+ type Unwrapped AttributeName = Text+ _Wrapped' = iso (\ (AttributeName x) -> x) AttributeName++-- | Capture the information about the <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/repeatCount repeatCount> attribute.+data RepeatCount+ = NumOfTimes Word+ | Indefinite+ deriving Eq++instance Show RepeatCount where+ show (NumOfTimes n) = show n+ show Indefinite = "indefinite"++-- | Helper function to convert a @Wrapped@ value to a @Text@ value.+wrappedToText+ :: ( Unwrapped t ~ Unwrapped s+ , IsText t1+ , Contravariant f+ , Functor f+ , Rewrapped t s+ , Rewrapped s t+ , Show (Unwrapped s)+ )+ => (t1 -> f t1)+ -> s+ -> f t+wrappedToText =+ _Wrapped . to show . packed
+ src/Reflex/Dom/Widget/SVG/Types/Pos.hs view
@@ -0,0 +1,82 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeFamilies #-}+-- | @Pos@ is a general purpose wrapper for the various times we want to+-- indicate we're using a specific positional value.+module Reflex.Dom.Widget.SVG.Types.Pos+ ( Pos+ , X+ , Y+ , CenterX+ , CenterY+ , _PosX+ , _PosY+ , _PosCenterX+ , _PosCenterY+ , changePosType+ , makePointsProp+ )+ where++import Control.Lens (Iso', Rewrapped,+ Wrapped (..), iso, (^.),+ _Wrapped)++import Data.Text (Text)++import Data.Semigroup ((<>))++import Data.List.NonEmpty (NonEmpty)++import Reflex.Dom.Widget.SVG.Types.Internal (wrappedToText)++-- | Types to help keep our respective coordinate types separate+data X+-- | Types to help keep our respective coordinate types separate+data Y+-- | Types to help keep our respective coordinate types separate+data CenterX+-- | Types to help keep our respective coordinate types separate+data CenterY++-- | Wrap up the normal @Float@ value with a @newtype@ so that we can't mix+-- things up as easily. Include a phantom type so we're able to be granular+-- about the specific position we're interested in.+newtype Pos p =+ Pos Float+ deriving (Eq, Show)++instance (Pos p) ~ t => Rewrapped (Pos p) t++instance Wrapped (Pos p) where+ type Unwrapped (Pos p) = Float+ _Wrapped' = iso (\(Pos x) -> x) Pos++-- | Change the @Pos@ index type+changePosType :: Pos a -> Pos b+changePosType (Pos p) = Pos p++-- | Specific Iso for describing a X coordinate+_PosX :: Iso' (Pos X) Float+_PosX = _Wrapped++-- | Specific Iso for describing a Y coordinate+_PosY :: Iso' (Pos Y) Float+_PosY = _Wrapped++-- | Specific Iso for describing a centered X coordinate+_PosCenterX :: Iso' (Pos CenterX) Float+_PosCenterX = _Wrapped++-- | Specific Iso for describing a centered Y coordinate+_PosCenterY :: Iso' (Pos CenterY) Float+_PosCenterY = _Wrapped++-- | Convert the list of points to a correctly formatted list of X/Y positions+-- expected by SVG attributes.+makePointsProp+ :: NonEmpty (Pos X, Pos Y)+ -> Text+makePointsProp = foldMap+ (\(x,y) -> (x ^. wrappedToText) <> "," <> (y ^. wrappedToText) <> " ")
+ src/Reflex/Dom/Widget/SVG/Types/Radius.hs view
@@ -0,0 +1,40 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies #-}+-- | Types and function for the @Radius@ wrapper.+module Reflex.Dom.Widget.SVG.Types.Radius+ ( Radius+ , _Radius+ , _RadiusX+ , _RadiusY+ ) where++import Control.Lens (Iso', Rewrapped, Wrapped (..),+ iso, _Wrapped)++import Reflex.Dom.Widget.SVG.Types.Pos (X, Y)++-- | The value of a @Radius@ is just a @Float@. But we can do better so we wrap+-- it up in a @newtype@ to keep things organised.+newtype Radius p =+ Radius Float+ deriving (Eq, Show)++instance (Radius p) ~ t => Rewrapped (Radius p) t++instance Wrapped (Radius p) where+ type Unwrapped (Radius p) = Float+ _Wrapped' = iso (\(Radius x) -> x) Radius++-- | Iso for the float value of a radius+_Radius :: Iso' (Radius ()) Float+_Radius = _Wrapped++-- | Iso for the float value of an X position radius+_RadiusX :: Iso' (Radius X) Float+_RadiusX = _Wrapped++-- | Iso for the float value of an Y position radius+_RadiusY :: Iso' (Radius Y) Float+_RadiusY = _Wrapped
+ src/Reflex/Dom/Widget/SVG/Types/SVG_Animate.hs view
@@ -0,0 +1,139 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeFamilies #-}+-- | Types and functions for the \<animate\> SVG element.+module Reflex.Dom.Widget.SVG.Types.SVG_Animate+ ( AnimFrom (..)+ , AnimTo (..)+ , AnimDuration (..)+ , AsAnimDuration (..)+ , SVG_Animate (..)+ , svg_animate_attributeName+ , svg_animate_from+ , svg_animate_to+ , svg_animate_dur+ , svg_animate_repeatCount+ , makeAnimateProps+ ) where++import Control.Lens (Lens', Prism', Rewrapped,+ Unwrapped, Wrapped (..),+ at, iso, prism, to, (?~),+ (^.), _Wrapped)++import Data.Function ((&))++import Data.Semigroup ((<>))++import Data.Text (Text, pack)+import Data.Text.Lens (packed)++import Data.Map (Map)++import GHC.Word (Word16)++import Reflex.Dom.Widget.SVG.Types.Internal (AttributeName (..),+ RepeatCount (..),+ wrappedToText)++-- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/from from> attribute+newtype AnimFrom = AnimFrom Word16 deriving (Eq, Show)++-- | <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/to to> attribute+newtype AnimTo = AnimTo Word16 deriving (Eq, Show)++instance AnimFrom ~ t => Rewrapped AnimFrom t+instance Wrapped AnimFrom where+ type Unwrapped AnimFrom = Word16+ _Wrapped' = iso (\ (AnimFrom x) -> x) AnimFrom++instance AnimTo ~ t => Rewrapped AnimTo t+instance Wrapped AnimTo where+ type Unwrapped AnimTo = Word16+ _Wrapped' = iso (\ (AnimTo x) -> x) AnimTo++-- | We don't allow for negative animation durations, and currently we're only+-- interested in animations that last a matter of seconds or milliseconds.+data AnimDuration+ = Secs Word16+ | MSecs Word16+ deriving (Eq, Show)++-- | Classy Prism set for the @AnimDuration@ type+class AsAnimDuration r where+ _AnimDuration :: Prism' r AnimDuration -- ^ General prism for when you have to deal with all of the constructors+ _Secs :: Prism' r Word16 -- ^ Prism for Seconds+ _MSecs :: Prism' r Word16 -- ^ Prism for Milliseconds+ _Secs = _AnimDuration . _Secs+ _MSecs = _AnimDuration . _MSecs++instance AsAnimDuration AnimDuration where+ _AnimDuration = id+ _Secs = prism Secs+ (\case Secs d -> Right d+ x -> Left x+ )+ _MSecs = prism MSecs+ (\case MSecs d -> Right d+ x -> Left x+ )++toText :: String -> Word16 -> Text+toText s = pack . (<> s) . show++animDurationToText :: AnimDuration -> Text+animDurationToText (Secs s) = toText "s" s+animDurationToText (MSecs ms) = toText "ms" ms++-- | Properties for the <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/animate \<animate\>> element.+data SVG_Animate = SVG_Animate+ { _svg_animate_attributeName :: AttributeName+ , _svg_animate_from :: AnimFrom+ , _svg_animate_to :: AnimTo+ , _svg_animate_dur :: AnimDuration+ , _svg_animate_repeatCount :: RepeatCount+ }+ deriving (Eq, Show)++-- | Lens for the @AttirbuteName@ of an @SVG_Animate@ element.+svg_animate_attributeName :: Lens' SVG_Animate AttributeName+svg_animate_attributeName f (SVG_Animate x1 x2 x3 x4 x5)+ = fmap (\y1 -> SVG_Animate y1 x2 x3 x4 x5) (f x1)+{-# INLINE svg_animate_attributeName #-}++-- | Lens for the @AnimDuration@ of an @SVG_Animate@ element.+svg_animate_dur :: Lens' SVG_Animate AnimDuration+svg_animate_dur f (SVG_Animate x1 x2 x3 x4 x5)+ = fmap (\y1 -> SVG_Animate x1 x2 x3 y1 x5) (f x4)+{-# INLINE svg_animate_dur #-}++-- | Lens for the @AnimFrom@ of an @SVG_Animate@ element.+svg_animate_from :: Lens' SVG_Animate AnimFrom+svg_animate_from f (SVG_Animate x1 x2 x3 x4 x5)+ = fmap (\y1 -> SVG_Animate x1 y1 x3 x4 x5) (f x2)+{-# INLINE svg_animate_from #-}++-- | Lens for the @AnimTo@ of an @SVG_Animate@ element.+svg_animate_to :: Lens' SVG_Animate AnimTo+svg_animate_to f (SVG_Animate x1 x2 x3 x4 x5)+ = fmap (\y1 -> SVG_Animate x1 x2 y1 x4 x5) (f x3)+{-# INLINE svg_animate_to #-}++-- | Lens for the @AnimRepeatCount@ of an @SVG_Animate@ element.+svg_animate_repeatCount :: Lens' SVG_Animate RepeatCount+svg_animate_repeatCount f (SVG_Animate x1 x2 x3 x4 x5)+ = fmap (SVG_Animate x1 x2 x3 x4) (f x5)+{-# INLINE svg_animate_repeatCount #-}++-- | Convert the given properties to the correct attributes for a \<animate\>.+makeAnimateProps+ :: SVG_Animate+ -> Map Text Text+makeAnimateProps a = mempty+ & at "attributeName" ?~ a ^. svg_animate_attributeName . _Wrapped+ & at "from" ?~ a ^. svg_animate_from . wrappedToText+ & at "to" ?~ a ^. svg_animate_to . wrappedToText+ & at "dur" ?~ a ^. svg_animate_dur . to animDurationToText+ & at "repeatCount" ?~ a ^. svg_animate_repeatCount . to show . packed
+ src/Reflex/Dom/Widget/SVG/Types/SVG_Circle.hs view
@@ -0,0 +1,57 @@+{-# LANGUAGE OverloadedStrings #-}+-- | Types and functions for the \<circle\> SVG element.+module Reflex.Dom.Widget.SVG.Types.SVG_Circle+ ( SVG_Circle (..)+ , svg_circle_pos_centerX+ , svg_circle_pos_centerY+ , svg_circle_radius+ , makeCircleProps+ ) where++import Control.Lens (Lens', at, (?~), (^.))++import Data.Function ((&))++import Data.Map (Map)++import Data.Text (Text)++import Reflex.Dom.Widget.SVG.Types.Internal (wrappedToText)+import Reflex.Dom.Widget.SVG.Types.Pos (CenterX, CenterY, Pos)+import Reflex.Dom.Widget.SVG.Types.Radius (Radius)++-- | Properties for the <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/circle \<circle\>> element.+data SVG_Circle = SVG_Circle+ { _svg_circle_pos_centerX :: Pos CenterX+ , _svg_circle_pos_centerY :: Pos CenterY+ , _svg_circle_radius :: Radius ()+ }+ deriving (Eq, Show)+++-- | Lens for the Center X position of an @SVG_Circle@+svg_circle_pos_centerX :: Lens' SVG_Circle (Pos CenterX)+svg_circle_pos_centerX f (SVG_Circle x1 x2 x3)+ = fmap (\y1 -> SVG_Circle y1 x2 x3) (f x1)+{-# INLINE svg_circle_pos_centerX #-}++-- | Lens for the Center Y position of an @SVG_Circle@+svg_circle_pos_centerY :: Lens' SVG_Circle (Pos CenterY)+svg_circle_pos_centerY f (SVG_Circle x1 x2 x3)+ = fmap (\y1 -> SVG_Circle x1 y1 x3) (f x2)+{-# INLINE svg_circle_pos_centerY #-}++-- | Lens for the @Radius@ of an @SVG_Circle@+svg_circle_radius :: Lens' SVG_Circle (Radius ())+svg_circle_radius f (SVG_Circle x1 x2 x3)+ = fmap (SVG_Circle x1 x2) (f x3)+{-# INLINE svg_circle_radius #-}++-- | Convert the given properties to the correct attributes for a \<circle\>.+makeCircleProps+ :: SVG_Circle+ -> Map Text Text+makeCircleProps c = mempty+ & at "cx" ?~ c ^. svg_circle_pos_centerX . wrappedToText+ & at "cy" ?~ c ^. svg_circle_pos_centerY . wrappedToText+ & at "r" ?~ c ^. svg_circle_radius . wrappedToText
+ src/Reflex/Dom/Widget/SVG/Types/SVG_Ellipse.hs view
@@ -0,0 +1,65 @@+{-# LANGUAGE OverloadedStrings #-}+-- | Types and functions for the \<ellipse\> SVG element.+module Reflex.Dom.Widget.SVG.Types.SVG_Ellipse+ ( SVG_Ellipse (..)+ , svg_ellipse_radius_x+ , svg_ellipse_radius_y+ , svg_ellipse_center_x+ , svg_ellipse_center_y+ , makeEllipseProps+ ) where++import Control.Lens (Lens', at, (?~), (^.))++import Data.Function ((&))+import Data.Map (Map)++import Data.Text (Text)++import Reflex.Dom.Widget.SVG.Types.Internal (wrappedToText)+import Reflex.Dom.Widget.SVG.Types.Pos (CenterX, CenterY, Pos, X,+ Y)+import Reflex.Dom.Widget.SVG.Types.Radius (Radius)++-- | Properties for the <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/ellipse \<ellipse\>> element.+data SVG_Ellipse = SVG_Ellipse+ { _svg_ellipse_radius_x :: Radius X+ , _svg_ellipse_radius_y :: Radius Y+ , _svg_ellipse_center_x :: Pos CenterX+ , _svg_ellipse_center_y :: Pos CenterY+ }+ deriving (Eq, Show)++-- | Lens for the Center X position of an @SVG_Ellipse@+svg_ellipse_center_x :: Lens' SVG_Ellipse (Pos CenterX)+svg_ellipse_center_x f (SVG_Ellipse x1 x2 x3 x4)+ = fmap (\y1 -> SVG_Ellipse x1 x2 y1 x4) (f x3)+{-# INLINE svg_ellipse_center_x #-}++-- | Lens for the Center Y position of an @SVG_Ellipse@+svg_ellipse_center_y :: Lens' SVG_Ellipse (Pos CenterY)+svg_ellipse_center_y f (SVG_Ellipse x1 x2 x3 x4)+ = fmap (SVG_Ellipse x1 x2 x3) (f x4)+{-# INLINE svg_ellipse_center_y #-}++-- | Lens for the Radius along the X axis of an @SVG_Ellipse@+svg_ellipse_radius_x :: Lens' SVG_Ellipse (Radius X)+svg_ellipse_radius_x f (SVG_Ellipse x1 x2 x3 x4)+ = fmap (\y1 -> SVG_Ellipse y1 x2 x3 x4) (f x1)+{-# INLINE svg_ellipse_radius_x #-}++-- | Lens for the Radius along the Y axis of an @SVG_Ellipse@+svg_ellipse_radius_y :: Lens' SVG_Ellipse (Radius Y)+svg_ellipse_radius_y f (SVG_Ellipse x1 x2 x3 x4)+ = fmap (\y1 -> SVG_Ellipse x1 y1 x3 x4) (f x2)+{-# INLINE svg_ellipse_radius_y #-}++-- | Convert the given properties to the correct attributes for a \<ellipse\>.+makeEllipseProps+ :: SVG_Ellipse+ -> Map Text Text+makeEllipseProps e = mempty+ & at "cx" ?~ e ^. svg_ellipse_center_x . wrappedToText+ & at "cy" ?~ e ^. svg_ellipse_center_y . wrappedToText+ & at "rx" ?~ e ^. svg_ellipse_radius_x . wrappedToText+ & at "ry" ?~ e ^. svg_ellipse_radius_y . wrappedToText
+ src/Reflex/Dom/Widget/SVG/Types/SVG_Line.hs view
@@ -0,0 +1,49 @@+{-# LANGUAGE OverloadedStrings #-}+-- | Types and functions for \<line\> SVG element.+module Reflex.Dom.Widget.SVG.Types.SVG_Line+ ( SVG_Line (..)+ , svg_line_pos_end+ , svg_line_pos_start+ , makeSVGLineProps+ ) where++import Control.Lens (Lens', at, (?~), (^.),+ _1, _2)++import Data.Function ((&))++import Data.Map (Map)++import Data.Text (Text)++import Reflex.Dom.Widget.SVG.Types.Internal (wrappedToText)+import Reflex.Dom.Widget.SVG.Types.Pos (Pos, X, Y)++-- | Properties for the <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/line \<line\>> element.+data SVG_Line = SVG_Line+ { _svg_line_pos_start :: ( Pos X, Pos Y )+ , _svg_line_pos_end :: ( Pos X, Pos Y )+ }+ deriving (Eq, Show)++-- | Lens for the end of the @SVG_Line@+svg_line_pos_end :: Lens' SVG_Line (Pos X, Pos Y)+svg_line_pos_end f (SVG_Line x1 x2)+ = fmap (SVG_Line x1) (f x2)+{-# INLINE svg_line_pos_end #-}++-- | Lens for the start of the @SVG_Line@+svg_line_pos_start :: Lens' SVG_Line (Pos X, Pos Y)+svg_line_pos_start f (SVG_Line x1 x2)+ = fmap (`SVG_Line` x2) (f x1)+{-# INLINE svg_line_pos_start #-}++-- | Convert our @SVG_Line@ to the correct attribute map for Reflex.+makeSVGLineProps+ :: SVG_Line+ -> Map Text Text+makeSVGLineProps l = mempty+ & at "x1" ?~ l ^. svg_line_pos_start . _1 . wrappedToText+ & at "y1" ?~ l ^. svg_line_pos_start . _2 . wrappedToText+ & at "x2" ?~ l ^. svg_line_pos_end . _1 . wrappedToText+ & at "y2" ?~ l ^. svg_line_pos_end . _2 . wrappedToText
+ src/Reflex/Dom/Widget/SVG/Types/SVG_Path.hs view
@@ -0,0 +1,237 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeFamilies #-}+-- | Types and functions for constructing type-safe SVG \<path\> properties.+module Reflex.Dom.Widget.SVG.Types.SVG_Path+ ( PathCommandType (..)+ , PathCommand (..)+ , PathCommandRelativity (..)+ , SVG_Path (..)+ , P (..)+ , _SmthQuadBez+ , _QuadBez+ , _SmthCubicBez+ , _CubicBez+ , _MoveTo+ , _LineTo+ , _Horizontal+ , _Vertical+ , _ClosePath+ , _PathComm+ , _m+ , _M+ , _l+ , _L+ , _h+ , _H+ , _v+ , _V+ , _z+ , _Z+ , makePathProps+ , pathCommandToText+ ) where++import Control.Lens (Prism', Rewrapped,+ Wrapped (..), iso, prism,+ ( # ), (^.), _1, _2,+ _Wrapped)++import Data.Map (Map)++import Data.List.NonEmpty (NonEmpty, toList)++import Data.Semigroup (Semigroup (..), (<>))++import Data.Text (Text)+import qualified Data.Text as Text++import Reflex.Dom.Core ((=:))++import Reflex.Dom.Widget.SVG.Types.Internal (wrappedToText)+import Reflex.Dom.Widget.SVG.Types.Pos (Pos, X, Y)++-- | For a bit of brevity we wrap a combined X,Y position in a tuple tucked in a newtype.+newtype P =+ P (Pos X, Pos Y)+ deriving (Eq, Show)++instance P ~ t => Rewrapped P t++instance Wrapped P where+ type Unwrapped P = (Pos X, Pos Y)+ _Wrapped' = iso (\(P x) -> x) P++-- | These are the commands to be used when building the 'd' attribute for an SVG <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/path path> element.+data PathCommandType+ = MoveTo P -- ^ Pick up and move the drawing instrument to another position+ | LineTo P -- ^ Draw a straight line+ | Horizontal (Pos X) -- ^ Straight horizontal line+ | Vertical (Pos Y) -- ^ Straight vertical line+ | SmthQuadBez P -- ^ Smooth Quadratic Bezier Curve+ | QuadBez P P -- ^ Quadratic Bezier Curve using the given control points+ | SmthCubicBez P P -- ^ Smooth Cubic Bezier Curve with control points at the end+ | CubicBez P P P -- ^ Cubic Bezier Curve with beginning and end control points+ | ClosePath -- ^ Draw a straight line from the current position to the first point in the path.+ deriving (Eq, Show)++-- | Indicates if a given command is expected to distances from the current+-- position or be set coordinates. See the <https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/d documentation> for more.+data PathCommandRelativity+ = Relative -- ^ Input are considered distances relative to the current position+ | Absolute -- ^ Input is considered to be an absolute position+ deriving (Eq, Show)++-- | To be able to describe a path command, we need to know the command you would+-- like to use (and its inputs). As well as whether or not you're issuing a+-- relative command, or an absolute one.+data PathCommand+ = PathComm PathCommandType PathCommandRelativity+ deriving (Eq, Show)++-- | A wrapper for a list of commands to describe a SVG path. An empty list of+-- commands doesn't make sense, so you have to construct a @NonEmpty@ list.+newtype SVG_Path =+ D (NonEmpty PathCommand)+ deriving (Eq, Show, Semigroup)++instance SVG_Path ~ t => Rewrapped SVG_Path t++instance Wrapped SVG_Path where+ type Unwrapped SVG_Path = (NonEmpty PathCommand)+ _Wrapped' = iso (\(D x) -> x) D++-- | Prism for a Smooth Quadradic Bezier Curve [<https://developer.mozilla.org/en-US/docs/User:Jt_Sandbox/Curves_in_Paths MDN>]+_SmthQuadBez :: Prism' PathCommandType P+_SmthQuadBez = prism SmthQuadBez+ (\case SmthQuadBez x1y1 -> Right x1y1+ x -> Left x+ )++-- | Prism for a Quadradic Bezier Curve [<https://developer.mozilla.org/en-US/docs/User:Jt_Sandbox/Curves_in_Paths MDN>]+_QuadBez :: Prism' PathCommandType (P, P)+_QuadBez = prism (uncurry QuadBez)+ (\case QuadBez x1y1 x2y2 -> Right (x1y1, x2y2)+ x -> Left x+ )+++-- | Prism for a Smooth Cubic Bezier Curve [<https://developer.mozilla.org/en-US/docs/User:Jt_Sandbox/Curves_in_Paths MDN>]+_SmthCubicBez :: Prism' PathCommandType (P, P)+_SmthCubicBez = prism (uncurry SmthCubicBez)+ (\case SmthCubicBez x1y1 x2y2 -> Right (x1y1, x2y2)+ x -> Left x+ )++-- | Prism for a Cubic Bezier Curve [<https://developer.mozilla.org/en-US/docs/User:Jt_Sandbox/Curves_in_Paths MDN>]+_CubicBez :: Prism' PathCommandType (P, P, P)+_CubicBez = prism (\(x1y1,x2y2,x3y3) -> CubicBez x1y1 x2y2 x3y3)+ (\case CubicBez x1y1 x2y2 x3y3 -> Right (x1y1, x2y2, x3y3)+ x -> Left x+ )++-- | Prism for the 'M/m' command [<https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/d MDN>]+_MoveTo :: Prism' PathCommandType P+_MoveTo = prism MoveTo+ (\case MoveTo xy -> Right xy+ x -> Left x)++-- | Prism for the 'L/l' command [<https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/d MDN>]+_LineTo :: Prism' PathCommandType P+_LineTo = prism LineTo+ (\case LineTo xy -> Right xy+ x -> Left x)++-- | Prism for the 'H/h' command [<https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/d MDN>]+_Horizontal :: Prism' PathCommandType (Pos X)+_Horizontal = prism Horizontal+ (\case Horizontal y1 -> Right y1+ x -> Left x)++-- | Prism for the 'V/v' command [<https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/d MDN>]+_Vertical :: Prism' PathCommandType (Pos Y)+_Vertical = prism Vertical+ (\case Vertical y1 -> Right y1+ x -> Left x)++-- | Prism for the 'Z/z' command [<https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/d MDN>]+_ClosePath :: Prism' PathCommandType ()+_ClosePath = prism (const ClosePath)+ (\case ClosePath -> Right ()+ x -> Left x)++-- | Prism for the @PathCommand@ that encompasses the command and it's relativity.+_PathComm :: Prism' PathCommand (PathCommandType, PathCommandRelativity)+_PathComm = prism (uncurry PathComm) (\(PathComm t r) -> Right (t, r))++absolutePosition, relativePath :: PathCommandType -> PathCommand+relativePath pc = _PathComm # (pc, Relative)+absolutePosition pc = _PathComm # (pc, Absolute)++-- | These are some short-hand functions to help in the construction of a+-- @PathCommand@. Named to match their respective SVG equivalent.+_m,_M,_l,_L :: Pos X -> Pos Y -> PathCommand+_m x y = relativePath $ _MoveTo . _Wrapped # (x,y)+_M x y = absolutePosition $ _MoveTo . _Wrapped # (x,y)+_l x y = relativePath $ _LineTo . _Wrapped # (x,y)+_L x y = absolutePosition $ _LineTo . _Wrapped # (x,y)++-- | These are some short-hand functions to help in the construction of a+-- @PathCommand@. Named to match their respective SVG equivalent.+_h,_H :: Pos X -> PathCommand+_h = relativePath . (_Horizontal #)+_H = absolutePosition . (_Horizontal #)++-- | These are some short-hand functions to help in the construction of a+-- @PathCommand@. Named to match their respective SVG equivalent.+_v,_V :: Pos Y -> PathCommand+_v = relativePath . (_Vertical #)+_V = absolutePosition . (_Vertical #)++-- | These are some short-hand functions to help in the construction of a+-- @PathCommand@. Named to match their respective SVG equivalent.+_z,_Z :: PathCommand+_z = relativePath (_ClosePath # ())+_Z = absolutePosition (_ClosePath # ())++-- | Take a given @PathCommand@ and produce a @Text@ that is intended for a 'd'+-- attribute of a \<path\> element.+pathCommandToText+ :: PathCommand+ -> Text+pathCommandToText ( PathComm pc pcr ) =+ let+ rComm c' Relative = Text.toLower c'+ rComm c' _ = c'++ pt2 xy =+ let+ ptx = xy ^. _Wrapped . _1 . wrappedToText+ pty = xy ^. _Wrapped . _2 . wrappedToText+ in+ ptx <> "," <> pty+ in+ case pc of+ MoveTo xy -> rComm "M" pcr <> pt2 xy+ LineTo xy -> rComm "L" pcr <> " " <> pt2 xy+ Horizontal x -> rComm "H" pcr <> " " <> x ^. wrappedToText+ Vertical y -> rComm "V" pcr <> " " <> y ^. wrappedToText++ SmthQuadBez xy -> rComm "T" pcr <> pt2 xy+ QuadBez cpxcpy1 xy -> rComm "Q" pcr <> pt2 cpxcpy1 <> pt2 xy+ SmthCubicBez cpxcpy2 xy -> rComm "S" pcr <> pt2 cpxcpy2 <> pt2 xy+ CubicBez cpxcpy1 cpxcpy2 xy -> rComm "C" pcr <> pt2 cpxcpy1 <> pt2 cpxcpy2 <> pt2 xy++ ClosePath -> rComm "Z" pcr++-- | Convert a @SVG_Path@ to a @Map Text Text@ that includes the correctly formatted 'd' attribute.+makePathProps+ :: SVG_Path+ -> Map Text Text+makePathProps (D p) =+ ( "d" =: ) . Text.unwords . toList $ pathCommandToText <$> p
+ src/Reflex/Dom/Widget/SVG/Types/SVG_PolyLine.hs view
@@ -0,0 +1,52 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+-- | Types and functions for the \<polyline\> SVG element.+--+-- The \<polyline\> SVG element is an SVG basic shape that creates straight lines+-- connecting several points. Typically a polyline is used to create open shapes+-- as the last point doesn't have to be connected to the first point. For closed+-- shapes see the \<polygon\> element.+module Reflex.Dom.Widget.SVG.Types.SVG_PolyLine+ ( SVG_PolyLine (..)+ , svg_polyLine_path+ , svg_polyLine_start+ , makePolyLineProps+ ) where++import Control.Lens (Lens')++import Data.Map (Map)++import Data.Text (Text)++import Data.List.NonEmpty (NonEmpty, (<|))++import Reflex.Dom.Core ((=:))++import Reflex.Dom.Widget.SVG.Types.Pos (Pos, X, Y, makePointsProp)++-- | Properties for the <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/polyline \<polyline\>> element.+data SVG_PolyLine = SVG_PolyLine+ { _svg_polyLine_start :: (Pos X, Pos Y)+ , _svg_polyLine_path :: NonEmpty (Pos X, Pos Y)+ }+ deriving (Eq, Show)++-- | Lens for the list of @(Pos X, Pos Y)@ of an @SVG_PolyLine@ path attribute.+svg_polyLine_path :: Lens' SVG_PolyLine (NonEmpty (Pos X, Pos Y))+svg_polyLine_path f (SVG_PolyLine x1 x2)+ = fmap (SVG_PolyLine x1) (f x2)+{-# INLINE svg_polyLine_path #-}++-- | Lens for the starting @(Pos X, Pos Y)@ of an @SVG_PolyLine@ element.+svg_polyLine_start :: Lens' SVG_PolyLine (Pos X, Pos Y)+svg_polyLine_start f (SVG_PolyLine x1 x2)+ = fmap (`SVG_PolyLine` x2) (f x1)+{-# INLINE svg_polyLine_start #-}++-- | Convert the given properties to the correct 'points' attribute of a \<polygon\>.+makePolyLineProps+ :: SVG_PolyLine+ -> Map Text Text+makePolyLineProps SVG_PolyLine {..} =+ "points" =: makePointsProp (_svg_polyLine_start <| _svg_polyLine_path)
+ src/Reflex/Dom/Widget/SVG/Types/SVG_Polygon.hs view
@@ -0,0 +1,47 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+-- | Types and functions for the \<polygon\> SVG element.+--+-- The \<polygon\> element defines a closed shape consisting of a set of connected+-- straight line segments. The last point is connected to the first point. For+-- open shapes see the \<polyline\> element.+module Reflex.Dom.Widget.SVG.Types.SVG_Polygon+ ( SVG_Polygon (..)+ , svg_polygon_path+ , svg_polygon_start+ , makePolygonProps+ ) where++import Control.Lens (Lens')++import Data.List.NonEmpty (NonEmpty, (<|))+import Data.Map (Map)+import Data.Text (Text)++import Reflex.Dom.Core ((=:))++import Reflex.Dom.Widget.SVG.Types.Pos (Pos, X, Y, makePointsProp)++-- | Properties for the <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/polygon \<polygon\>> element.+data SVG_Polygon = SVG_Polygon+ { _svg_polygon_start :: (Pos X, Pos Y)+ , _svg_polygon_path :: NonEmpty (Pos X, Pos Y)+ }+ deriving (Eq, Show)++-- | Lens for the list of @(Pos X, Pos Y)@ of an @SVG_Polygon@ path attribute.+svg_polygon_path :: Lens' SVG_Polygon (NonEmpty (Pos X, Pos Y))+svg_polygon_path f (SVG_Polygon x1 x2) = fmap (SVG_Polygon x1) (f x2)+{-# INLINE svg_polygon_path #-}++-- | Lens for the starting @(Pos X, Pos Y)@ of an @SVG_Polygon@ element.+svg_polygon_start :: Lens' SVG_Polygon (Pos X, Pos Y)+svg_polygon_start f (SVG_Polygon x1 x2) = fmap (`SVG_Polygon` x2) (f x1)+{-# INLINE svg_polygon_start #-}++-- | Convert the given properties to the correct 'points' attribute of a \<polygon\>.+makePolygonProps+ :: SVG_Polygon+ -> Map Text Text+makePolygonProps SVG_Polygon {..} =+ "points" =: makePointsProp (_svg_polygon_start <| _svg_polygon_path)
+ src/Reflex/Dom/Widget/SVG/Types/SVG_Rect.hs view
@@ -0,0 +1,88 @@+{-# LANGUAGE OverloadedStrings #-}+-- | Types and lenses for the \<rect\> SVG element.+module Reflex.Dom.Widget.SVG.Types.SVG_Rect+ ( SVG_Rect (..)+ , svg_rect_pos_x+ , svg_rect_pos_y+ , svg_rect_width+ , svg_rect_height+ , svg_rect_cornerRadius_x+ , svg_rect_cornerRadius_y+ , makeRectProps+ )+ where++import Control.Lens (Lens', at, (.~),+ (?~), (^.), (^?),+ _Just)++import Data.Function ((&))++import Data.Map (Map)++import Data.Text (Text)++import Reflex.Dom.Widget.SVG.Types.CornerRadius (CornerRadius)+import Reflex.Dom.Widget.SVG.Types.Pos (Pos, X, Y)++import Reflex.Dom.Widget.SVG.Types.Internal (Height, Width,+ wrappedToText)++-- | SVG <https://developer.mozilla.org/en-US/docs/Web/SVG/Element/rect \<rect\>> properties+data SVG_Rect = SVG_Rect+ { _svg_rect_pos_x :: Pos X -- ^ Top left X position+ , _svg_rect_pos_y :: Pos Y -- ^ Top left Y position+ , _svg_rect_width :: Width+ , _svg_rect_height :: Height+ , _svg_rect_cornerRadius_x :: Maybe (CornerRadius X) -- ^ Optional rounded corner radius+ , _svg_rect_cornerRadius_y :: Maybe (CornerRadius Y) -- ^ Optional rounded corner radius+ }+ deriving (Eq, Show)++-- | Lens for the X corner radius+svg_rect_cornerRadius_x :: Lens' SVG_Rect (Maybe (CornerRadius X))+svg_rect_cornerRadius_x f (SVG_Rect x1 x2 x3 x4 x5 x6)+ = fmap (\y1 -> SVG_Rect x1 x2 x3 x4 y1 x6) (f x5)+{-# INLINE svg_rect_cornerRadius_x #-}++-- | Lens for the Y corner radius+svg_rect_cornerRadius_y :: Lens' SVG_Rect (Maybe (CornerRadius Y))+svg_rect_cornerRadius_y f (SVG_Rect x1 x2 x3 x4 x5 x6)+ = fmap (SVG_Rect x1 x2 x3 x4 x5) (f x6)+{-# INLINE svg_rect_cornerRadius_y #-}++-- | Lens for the @Width@ of a @SVG_Rect@+svg_rect_width :: Lens' SVG_Rect Width+svg_rect_width f (SVG_Rect x1 x2 x3 x4 x5 x6)+ = fmap (\y1 -> SVG_Rect x1 x2 y1 x4 x5 x6) (f x3)+{-# INLINE svg_rect_width #-}++-- | Lens for the @Height@ of a @SVG_Rect@+svg_rect_height :: Lens' SVG_Rect Height+svg_rect_height f (SVG_Rect x1 x2 x3 x4 x5 x6)+ = fmap (\y1 -> SVG_Rect x1 x2 x3 y1 x5 x6) (f x4)+{-# INLINE svg_rect_height #-}++-- | Lens for the @Pos X@ of a @SVG_Rect@+svg_rect_pos_x :: Lens' SVG_Rect (Pos X)+svg_rect_pos_x f (SVG_Rect x1 x2 x3 x4 x5 x6)+ = fmap (\y1 -> SVG_Rect y1 x2 x3 x4 x5 x6) (f x1)+{-# INLINE svg_rect_pos_x #-}++-- | Lens for the @Pos Y@ of a @SVG_Rect@+svg_rect_pos_y :: Lens' SVG_Rect (Pos Y)+svg_rect_pos_y f (SVG_Rect x1 x2 x3 x4 x5 x6)+ = fmap (\y1 -> SVG_Rect x1 y1 x3 x4 x5 x6) (f x2)+{-# INLINE svg_rect_pos_y #-}++-- | Convert the given properties to the correct attributes for a \<rect\>.+makeRectProps+ :: SVG_Rect+ -> Map Text Text+makeRectProps r = mempty+ & at "x" ?~ r ^. svg_rect_pos_x . wrappedToText+ & at "y" ?~ r ^. svg_rect_pos_y . wrappedToText+ & at "width" ?~ r ^. svg_rect_width . wrappedToText+ & at "height" ?~ r ^. svg_rect_height . wrappedToText+ & at "rx" .~ r ^? svg_rect_cornerRadius_x . _Just . wrappedToText+ & at "ry" .~ r ^? svg_rect_cornerRadius_y . _Just . wrappedToText