diff --git a/src/Routing/Duplex.purs b/src/Routing/Duplex.purs index d412681..d426f1d 100644 --- a/src/Routing/Duplex.purs +++ b/src/Routing/Duplex.purs @@ -8,6 +8,7 @@ module Routing.Duplex , path , root , end + , end' , segment , param , flag @@ -141,6 +142,11 @@ root = path "" end :: forall a b. RouteDuplex a b -> RouteDuplex a b end (RouteDuplex enc dec) = RouteDuplex enc (dec <* Parser.end) +-- | Strict version of `end codec` will only suceed if `codec` succeeds and there are no +-- | additional path segments, hashes, parameters remaining to be processed. +end' :: forall a b. RouteDuplex a b -> RouteDuplex a b +end' (RouteDuplex enc dec) = RouteDuplex enc (dec <* Parser.end') + -- | Consumes or prints a single path segment. -- | **Note:** [URI encoding and decoding](https://en.wikipedia.org/wiki/Percent-encoding) is done automatically. -- | diff --git a/src/Routing/Duplex/Generic.purs b/src/Routing/Duplex/Generic.purs index 5243f19..5811f28 100644 --- a/src/Routing/Duplex/Generic.purs +++ b/src/Routing/Duplex/Generic.purs @@ -8,7 +8,7 @@ import Data.Profunctor (dimap) import Data.Symbol (class IsSymbol) import Prim.Row as Row import Record as Record -import Routing.Duplex (RouteDuplex(..), RouteDuplex', end) +import Routing.Duplex (RouteDuplex(..), RouteDuplex', end, end') import Type.Proxy (Proxy(..)) -- | Builds a parser/printer from a record, where each record field corresponds @@ -25,6 +25,19 @@ sum -> RouteDuplex' a sum = dimap from to <<< gRouteDuplex end +-- | Builds a parser/printer from a record, where each record field corresponds +-- | to a constructor name for your data type. +-- | +-- | Note: this implicitly inserts calls to `end'` for each constructor, making +-- | the parser only valid for parsing URI suffixes. To parse URI prefixes, use `sumPrefix`. +sum' + :: forall a rep r + . Generic a rep + => GRouteDuplex rep r + => { | r } + -> RouteDuplex' a +sum' = dimap from to <<< gRouteDuplex end' + -- | A variation of `sum` that does not implicitly add an `end` to each branch. -- | This is useful for defining sub-parsers that may consume only some of the -- | URI segments, leaving the rest for subsequent parsers. diff --git a/src/Routing/Duplex/Parser.purs b/src/Routing/Duplex/Parser.purs index 9c96745..d013293 100644 --- a/src/Routing/Duplex/Parser.purs +++ b/src/Routing/Duplex/Parser.purs @@ -19,6 +19,7 @@ module Routing.Duplex.Parser , boolean , hash , end + , end' , module Routing.Duplex.Types ) where @@ -42,6 +43,7 @@ import Data.String (Pattern(..), split) import Data.String.CodeUnits as String import Data.Traversable (traverse) import Data.Tuple (Tuple(..)) +import Data.Tuple.Nested ((/\)) import JSURI (decodeURIComponent) import Routing.Duplex.Types (RouteParams, RouteState) @@ -59,8 +61,11 @@ instance showRouteResult :: Show a => Show (RouteResult a) where data RouteError = Expected String String | ExpectedEndOfPath String + | ExpectedNoHash String + | ExpectedNoParams RouteParams | MissingParam String | MalformedURIComponent String + | MissingHash | EndOfPath derive instance eqRouteError :: Eq RouteError @@ -185,7 +190,12 @@ parsePath = splitNonEmpty p s = split p s toRouteState (Tuple (Tuple segments params) h) = - { segments, params, hash: h } + { segments + , params + , hash: case h of + "" -> Nothing + h' -> Just h' + } splitAt k p str = case String.indexOf (Pattern p) str of @@ -213,7 +223,7 @@ take = Chomp \state -> param :: String -> RouteParser String param key = Chomp \state -> case lookup key state.params of - Just a -> Success state a + Just a -> Success (state { params = Array.delete (key /\ a) state.params }) a _ -> Fail $ MissingParam key flag :: String -> RouteParser Boolean @@ -259,7 +269,9 @@ int :: String -> Either String Int int = maybe (Left "Int") Right <<< Int.fromString hash :: RouteParser String -hash = Chomp \state -> Success state state.hash +hash = Chomp \state -> case state.hash of + Nothing -> Fail MissingHash + Just h -> Success (state { hash = Nothing }) h end :: RouteParser Unit end = Chomp \state -> @@ -267,6 +279,14 @@ end = Chomp \state -> Nothing -> Success state unit Just str -> Fail (ExpectedEndOfPath str) +end' :: RouteParser Unit +end' = Chomp \state -> + case (Array.head state.segments /\ state.hash /\ state.params) of + (Nothing /\ Nothing /\ []) -> Success state unit + (Just str /\ _ /\ _) -> Fail (ExpectedEndOfPath str) + (_ /\ Just h /\ _) -> Fail (ExpectedNoHash h) + (_ /\ _ /\ params) -> Fail (ExpectedNoParams params) + boolean :: String -> Either String Boolean boolean = case _ of "true" -> Right true diff --git a/src/Routing/Duplex/Printer.purs b/src/Routing/Duplex/Printer.purs index cac2b96..30efa06 100644 --- a/src/Routing/Duplex/Printer.purs +++ b/src/Routing/Duplex/Printer.purs @@ -41,7 +41,9 @@ flag key val | otherwise = mempty hash :: String -> RoutePrinter -hash h = RoutePrinter _ { hash = h } +hash h + | h == "" = RoutePrinter _ { hash = Nothing } + | otherwise = RoutePrinter _ { hash = Just h } run :: RoutePrinter -> String run = printPath <<< applyFlipped emptyRouteState <<< unwrap @@ -60,5 +62,5 @@ printPath { segments, params, hash: hash' } = printParam key "" = encodeURIComponent key printParam key val = encodeURIComponent key <> Just "=" <> encodeURIComponent val - printHash "" = "" - printHash h = "#" <> h + printHash Nothing = "" + printHash (Just h) = "#" <> h diff --git a/src/Routing/Duplex/Types.purs b/src/Routing/Duplex/Types.purs index b70d092..1afbd5a 100644 --- a/src/Routing/Duplex/Types.purs +++ b/src/Routing/Duplex/Types.purs @@ -1,5 +1,6 @@ module Routing.Duplex.Types where +import Data.Maybe (Maybe(..)) import Data.Tuple (Tuple) type RouteParams = Array (Tuple String String) @@ -7,12 +8,12 @@ type RouteParams = Array (Tuple String String) type RouteState = { segments :: Array String , params :: RouteParams - , hash :: String + , hash :: Maybe String } emptyRouteState :: RouteState emptyRouteState = { segments: [] , params: [] - , hash: "" + , hash: Nothing } diff --git a/test/Unit.purs b/test/Unit.purs index 23b4af8..4ea1953 100644 --- a/test/Unit.purs +++ b/test/Unit.purs @@ -51,6 +51,7 @@ combinatorUnitTests = do -- hash assertEqual { actual: parse hash "abc#def", expected: Right "def" } + assertEqual { actual: parse hash "abc", expected: Left MissingHash } -- suffix assertEqual { actual: parse (suffix segment "latest") "release/latest", expected: Right "release" }