Merge pull request #11 from safareli/update

Update URI

Author: safareli

bower.json

@@ -13,7 +13,7 @@
     "purescript-dom-classy": "^2.1.0",
     "purescript-transformers": "^3.2.0",
     "purescript-control": "^3.0.0",
-    "purescript-uri": "^4.0.0",
+    "purescript-uri": "^5.0.0",
     "purescript-colors": "^4.0.0",
     "purescript-symbols": "^3.0.0",
     "purescript-canvas": "^3.0.0",

example/src/Main.purs

@@ -3,37 +3,62 @@ module Main where
 import Prelude
 
 import Color as Color
-
 import Control.Monad.Eff (Eff)
-import Control.Monad.Eff.Ref (REF)
-import Control.Monad.Eff.Random (RANDOM, random)
 import Control.Monad.Eff.Class (liftEff)
+import Control.Monad.Eff.Random (RANDOM, random)
+import Control.Monad.Eff.Ref (REF)
 import Control.Monad.Maybe.Trans (MaybeT(..), runMaybeT)
-
+import DOM (DOM)
+import DOM.Classy.ParentNode (class IsParentNode, querySelector)
+import DOM.HTML (window)
+import DOM.HTML.Window (document)
 import Data.Array as A
 import Data.Either (Either(..))
-import Data.Traversable as F
 import Data.Maybe (Maybe(..))
 import Data.Newtype (wrap)
-import Data.Path.Pathy (file, dir, (</>), rootDir, currentDir)
-import Data.URI (URIRef)
-import Data.URI as URI
-
-import DOM (DOM)
-import DOM.HTML (window)
-import DOM.Classy.ParentNode (class IsParentNode, querySelector)
-import DOM.HTML.Window (document)
-
+import Data.String.NonEmpty as NES
+import Data.These (These(..))
+import Data.Traversable as F
+import Data.Tuple (Tuple(..))
 import Graphics.Canvas (CANVAS)
-
+import HeatmapLayerData (heatmapLayerData)
+import Leaflet.Core (mkLeafURIRef)
 import Leaflet.Core as LC
+import Leaflet.Core.Types (LeafURIRef)
 import Leaflet.Plugin.Heatmap as LH
 import Leaflet.Util ((×))
-
-import HeatmapLayerData (heatmapLayerData)
+import Partial.Unsafe (unsafePartial)
+import URI (Authority(..), Fragment, HierPath, HierarchicalPart(..), Host(..), Path(..), PathAbsolute(..), Port, Query, RelPath, RelativePart(..), RelativeRef(..), URI(..), URIRef, UserInfo)
+import URI.Host.RegName as RegName
+import URI.HostPortPair (HostPortPair)
+import URI.HostPortPair as HostPortPair
+import URI.Path.Segment (segmentNZFromString)
+import URI.Path.Segment as PathSegment
+import URI.Scheme as Scheme
+import URI.URIRef (URIRefOptions)
 
 foreign import onload ∷ ∀ e a. Eff e a → Eff e a
 
+type MainURIRef = URIRef UserInfo (HostPortPair Host Port) Path HierPath RelPath Query Fragment
+
+mainURIRefOptions ∷ Record (URIRefOptions UserInfo (HostPortPair Host Port) Path HierPath RelPath Query Fragment)
+mainURIRefOptions =
+  { parseUserInfo: pure
+  , printUserInfo: id
+  , parseHosts: HostPortPair.parser pure pure
+  , printHosts: HostPortPair.print id id
+  , parsePath: pure
+  , printPath: id
+  , parseHierPath: pure
+  , printHierPath: id
+  , parseRelPath: pure
+  , printRelPath: id
+  , parseQuery: pure
+  , printQuery: id
+  , parseFragment: pure
+  , printFragment: id
+  }
+
 mkLatLngs ∷ ∀ e. MaybeT (Eff (dom ∷ DOM, random ∷ RANDOM|e)) (Array LC.LatLng)
 mkLatLngs = do
   let inp = A.range 0 5
@@ -47,22 +72,27 @@ mkLatLngs = do
   pure $ A.zipWith (\lat lng → {lat, lng}) lats lngs
 
 
-testURI ∷ URIRef
-testURI =
-  Left $ URI.URI
-  (Just $ URI.Scheme "http")
-  (URI.HierarchicalPart
-   (Just $ URI.Authority Nothing [(URI.NameAddress "{s}.tile.osm.org") × Nothing])
-   (Just $ Right $ rootDir </> dir "{z}" </> dir "{x}" </> file "{y}.png"))
-  Nothing
-  Nothing
-
-iconConf ∷ { iconUrl ∷ URIRef, iconSize ∷ LC.Point }
-iconConf =
-  { iconUrl: Right $ URI.RelativeRef
-      (URI.RelativePart Nothing $ Just $ Right $ currentDir </> file "marker.svg")
+testURI ∷ LeafURIRef
+testURI = mkLeafURIRef
+  { uri: Left $ URI
+      (Scheme.unsafeFromString "http")
+      (HierarchicalPartAuth
+      (Authority Nothing (Just $ This $ NameAddress $ RegName.fromString $ unsafePartial $ NES.unsafeFromString "{s}.tile.osm.org"))
+      (Path $ map PathSegment.segmentFromString ["{z}", "{x}", "{y}.png"]))
       Nothing
       Nothing
+  , opts: mainURIRefOptions
+  }
+
+iconConf ∷ { iconUrl ∷ LeafURIRef, iconSize ∷ LC.Point }
+iconConf =
+  { iconUrl: mkLeafURIRef
+      { uri: Right $ RelativeRef
+          (RelativePartNoAuth $ Just $ Left $ PathAbsolute $ Just $ Tuple (segmentNZFromString $ unsafePartial $ NES.unsafeFromString "marker.svg") [])
+          Nothing
+          Nothing
+      , opts: mainURIRefOptions
+      }
   , iconSize: 40 × 40
   }
 core

src/Leaflet/Core/Converter.purs

@@ -3,18 +3,17 @@ module Leaflet.Core.Converter where
 import Prelude
 
 import Color (Color, toHexString)
-
 import Data.Foldable (intercalate)
 import Data.String.Regex as RX
 import Data.String.Regex.Flags as RXF
 import Data.String.Regex.Unsafe as URX
-import Data.URI (URIRef)
-import Data.URI.URIRef as URIRef
+import Leaflet.Core.Types (LeafURIRef)
 import Leaflet.Core.Types as T
 import Leaflet.Util ((×), (∘))
+import URI.URIRef as URIRef
 
 type ConvertDict =
-  { printURI ∷ URIRef → String
+  { printURI ∷ LeafURIRef → String
   , mkPoint ∷ T.Point → Array Int
   , printColor ∷ Color → String
   , convertLatLng ∷ T.LatLng → Array T.Degrees
@@ -33,7 +32,7 @@ converter =
      let
       oRx = URX.unsafeRegex "%7B" RXF.global
       cRx = URX.unsafeRegex "%7D" RXF.global
-      encodedString = URIRef.print uri
+      encodedString = T.runLeafURIRef (\r -> URIRef.print r.opts r.uri) uri
       replaced = RX.replace oRx "{" $ RX.replace cRx "}" encodedString
      in replaced
   , mkPoint: \(a × b) → [a, b]

src/Leaflet/Core/Layer.purs

@@ -33,7 +33,7 @@ import Data.Array as A
 import Data.Foldable (class Foldable, foldMap)
 import Data.Function.Uncurried (Fn2, Fn3, runFn2, runFn3)
 import Data.Maybe (Maybe(..))
-import Data.URI (URIRef)
+import Leaflet.Core.Types (LeafURIRef)
 
 import DOM (DOM)
 
@@ -129,7 +129,7 @@ layer = liftEff layer_
 tileLayer
   ∷ ∀ e m
   . MonadEff (dom ∷ DOM|e) m
-  ⇒ URIRef
+  ⇒ LeafURIRef
   → m T.TileLayer
 tileLayer =
   liftEff ∘ tileLayer_ ∘ converter.printURI
@@ -163,7 +163,7 @@ popup r =
 setURI
   ∷ ∀ e m
   . MonadEff (dom ∷ DOM|e) m
-  ⇒ URIRef
+  ⇒ LeafURIRef
   → T.TileLayer
   → m T.TileLayer
 setURI uri tl =

src/Leaflet/Core/Types.purs

@@ -2,8 +2,9 @@ module Leaflet.Core.Types where
 
 import Color (Color)
 import Data.Tuple (Tuple)
-import Data.URI (URIRef)
-
+import Type.Data.Boolean (kind Boolean)
+import URI (URIRef)
+import URI.URIRef (URIRefOptions)
 import Unsafe.Coerce (unsafeCoerce)
 --------------------------------------------------------------------------------
 -- Abstract imported types
@@ -28,6 +29,27 @@ data Zoom
 data Degrees
 data LayerGroup
 data Control
+data LeafURIRef
+
+type LeafURIRefR userInfo hosts path hierPath relPath query fragment =
+  { uri :: URIRef userInfo hosts path hierPath relPath query fragment
+  , opts :: Record (URIRefOptions userInfo hosts path hierPath relPath query fragment)
+  }
+
+mkLeafURIRef
+  :: forall userInfo hosts path hierPath relPath query fragment
+   . LeafURIRefR userInfo hosts path hierPath relPath query fragment
+  -> LeafURIRef
+mkLeafURIRef = unsafeCoerce
+
+runLeafURIRef
+  :: forall r
+  . (forall userInfo hosts path hierPath relPath query fragment
+    . LeafURIRefR userInfo hosts path hierPath relPath query fragment
+    -> r)
+  -> LeafURIRef
+  -> r
+runLeafURIRef = unsafeCoerce
 
 -- layer converters
 tileToLayer ∷ TileLayer → Layer
@@ -132,13 +154,13 @@ type PopupConf =
 
 type IconConf =
   InteractiveLayerConf
-  ( iconUrl ∷ URIRef
-  , iconRetinaUrl ∷ URIRef
+  ( iconUrl ∷ LeafURIRef
+  , iconRetinaUrl ∷ LeafURIRef
   , iconSize ∷ Point
   , iconAnchor ∷ Point
   , popupAnchor ∷ Point
-  , shadowUrl ∷ URIRef
-  , shadowRetinaUrl ∷ URIRef
+  , shadowUrl ∷ LeafURIRef
+  , shadowRetinaUrl ∷ LeafURIRef
   , shadowSize ∷ Point
   , shadowAnchor ∷ Point
   , className ∷ String
@@ -189,3 +211,5 @@ type LayerControlConf r =
   , hideSingleBase ∷ Boolean
   , sortLayers ∷ Boolean
   | r )
+
+