Add Segmenter

Resolves #4

spago.dhall

@@ -7,6 +7,8 @@
   , "maybe"
   , "nullable"
   , "prelude"
+  , "tuples"
+  , "unfoldable"
   , "unsafe-coerce"
   ]
 , packages = ./packages.dhall

src/Web/Intl/Segmenter.js

@@ -0,0 +1,25 @@
+"use strict";
+
+export function _new(locales, options) {
+  return new Intl.Segmenter(locales, options);
+}
+
+export function _resolvedOptions(segmenter) {
+  return segmenter.resolvedOptions();
+}
+
+export function _segment(segmenter, string) {
+  return segmenter.segment(string)[Symbol.iterator]();
+}
+
+export function _supportedLocalesOf(locales, options) {
+  return Intl.Segmenter.supportedLocalesOf(locales, options);
+}
+
+export function _nextSegment(nothing, just, tuple, segments) {
+  const next = segments.next();
+  if (next.done) {
+    return nothing;
+  }
+  return just(tuple(next.value, segments));
+}

src/Web/Intl/Segmenter.purs

@@ -0,0 +1,126 @@
+module Web.Intl.Segmenter
+  -- * Types
+  ( Segmenter
+  , SegmenterOptions
+
+  -- * Constructor
+  , new
+  , new_
+
+  -- * Methods
+  , resolvedOptions
+  , supportedLocalesOf
+  , supportedLocalesOf_
+  , segment
+  ) where
+
+import Data.Array.NonEmpty (NonEmptyArray)
+import Data.Array.NonEmpty as NonEmpty
+import Data.Function.Uncurried (Fn2, Fn4)
+import Data.Function.Uncurried as Function.Uncurried
+import Data.Maybe (Maybe(..))
+import Data.Tuple (Tuple(..))
+import Data.Unfoldable (class Unfoldable)
+import Data.Unfoldable as Unfoldable
+import Effect (Effect)
+import Effect.Uncurried (EffectFn1, EffectFn2)
+import Effect.Uncurried as Effect.Uncurried
+import Prim.Row (class Union)
+import Unsafe.Coerce as Unsafe.Coerce
+import Web.Intl.Locale (Locale)
+
+foreign import data Segmenter :: Type
+
+type SegmenterOptions =
+  ( localeMatcher :: String
+  , granularity :: String
+  )
+
+foreign import _new
+  :: EffectFn2
+       (Array Locale)
+       (Record SegmenterOptions)
+       Segmenter
+
+new
+  :: forall options options'
+   . Union options options' SegmenterOptions
+  => NonEmptyArray Locale
+  -> Record options
+  -> Effect Segmenter
+new locales options =
+  Effect.Uncurried.runEffectFn2 _new (NonEmpty.toArray locales) (Unsafe.Coerce.unsafeCoerce options)
+
+new_ :: NonEmptyArray Locale -> Effect Segmenter
+new_ locales =
+  new locales {}
+
+foreign import _supportedLocalesOf
+  :: Fn2
+       (Array Locale)
+       (Record SegmenterOptions)
+       (Array String)
+
+supportedLocalesOf
+  :: forall options options'
+   . Union options options' SegmenterOptions
+  => NonEmptyArray Locale
+  -> Record options
+  -> Array String
+supportedLocalesOf locales options =
+  Function.Uncurried.runFn2 _supportedLocalesOf (NonEmpty.toArray locales) (Unsafe.Coerce.unsafeCoerce options)
+
+supportedLocalesOf_
+  :: NonEmptyArray Locale
+  -> Array String
+supportedLocalesOf_ locales =
+  supportedLocalesOf locales {}
+
+type Segment =
+  { segment :: String
+  , isWordLike :: Boolean
+  , input :: String
+  , index :: Int
+  }
+
+foreign import data Segments :: Type
+
+foreign import _segment
+  :: Fn2
+       Segmenter
+       String
+       Segments
+
+foreign import _nextSegment
+  :: Fn4
+       (forall a. Maybe a)
+       (forall a. a -> (Maybe a))
+       (forall a b. Fn2 a b (Tuple a b))
+       Segments
+       (Maybe (Tuple Segment Segments))
+
+segment
+  :: forall f
+   . Unfoldable f
+  => Segmenter
+  -> String
+  -> f Segment
+segment segmenter string =
+  Unfoldable.unfoldr
+    (Function.Uncurried.runFn4 _nextSegment Nothing Just (Function.Uncurried.mkFn2 Tuple))
+    (Function.Uncurried.runFn2 _segment segmenter string)
+
+type ResolvedOptions =
+  { locale :: String
+  , granularity :: String
+  }
+
+foreign import _resolvedOptions
+  :: EffectFn1
+       Segmenter
+       ResolvedOptions
+
+resolvedOptions
+  :: Segmenter
+  -> Effect ResolvedOptions
+resolvedOptions = Effect.Uncurried.runEffectFn1 _resolvedOptions

test/Main.purs

@@ -23,6 +23,7 @@ import Web.Intl.NumberFormat as NumberFormat
 import Web.Intl.PluralRules as PluralRules
 import Web.Intl.RelativeTimeFormat as RelativeTimeFormat
 import Web.Intl.RelativeTimeUnit (RelativeTimeUnit(..))
+import Web.Intl.Segmenter as Segmenter
 
 main :: Effect Unit
 main = do
@@ -36,6 +37,7 @@ main = do
   test_NumberFormat
   test_PluralRules
   test_RelativeTimeFormat
+  test_Segmenter
 
 test_Intl :: Effect Unit
 test_Intl = do
@@ -502,4 +504,44 @@ test_RelativeTimeFormat = do
         , numeric: "auto"
         , style: "long"
         }
-    }
+    }
+
+test_Segmenter :: Effect Unit
+test_Segmenter = do
+  en_US <- NonEmpty.singleton <$> Locale.new_ "en-US"
+
+  Console.log "Segmenter.supportedLocalesOf"
+  Test.assertEqual
+    { actual: Segmenter.supportedLocalesOf en_US { localeMatcher: "best fit" }
+    , expected: [ "en-US" ]
+    }
+
+  Console.log "Segmenter.supportedLocalesOf_"
+  Test.assertEqual
+    { actual: Segmenter.supportedLocalesOf_ en_US
+    , expected: [ "en-US" ]
+    }
+
+  segmenter <- Segmenter.new en_US { granularity: "word" }
+
+  Console.log "Segmenter.segment"
+  Test.assertEqual
+    { actual: _.segment <$> Segmenter.segment segmenter "Hello, world!"
+    , expected:
+        [ "Hello"
+        , ","
+        , " "
+        , "world"
+        , "!"
+        ]
+    }
+
+  Console.log "Segmenter.resolvedOptions"
+  resolvedOptions <- Segmenter.resolvedOptions segmenter
+  Test.assertEqual
+    { actual: resolvedOptions
+    , expected:
+        { locale: "en-US"
+        , granularity: "word"
+        }
+    }