simplified boomerang in Haskell and PureScript

sb.hs

module Main where

import Prelude hiding (id, (.))
import Control.Category
import Control.Monad ((>=>))

import Data.List (stripPrefix)

type URL = [String]
type Route a = (URL, a)

data Boom a b = Boom (a -> Maybe b) (b -> Maybe a)

inverse :: Boom a b -> Boom b a
inverse (Boom f g) = Boom g f

apply :: Boom a b -> a -> Maybe b
apply (Boom f g) = f

unapply :: Boom a b -> b -> Maybe a
unapply (Boom f g) = g

instance Category Boom where
  id = Boom Just Just
  g . f = Boom (apply f   >=> apply g)
               (unapply g >=> unapply f)

mkPure :: Boom URL URL -> Boom (Route r) (Route r)
mkPure (Boom from to) = Boom from' to'
  where
    comb b = (\a -> (a, b))
    from' = (\(url, raw) -> fmap (comb raw) $ from url)
    to'   = (\(url, raw) -> fmap (comb raw) $ to   url)

lit :: String -> Boom (Route r) (Route r)
lit s = mkPure $ Boom from to
  where
    from []     = Nothing
    from (x:xs) = case stripPrefix s x of
                    Nothing -> Nothing
                    Just x' -> Just (x':xs)
    to (x:xs) = Just $ (s ++ x):xs

anyString :: Boom (Route r) (Route (String, r))
anyString = Boom from to
  where
    from ([], raw)    = Nothing
    from (x:xs, raw)
      | length x == 0 = Nothing
      | otherwise     = Just ("":xs, (x, raw))
    to (x:xs, (s, r)) = Just ((x ++ s):xs, r)

infixl 0 </>
(</>) :: Boom (Route a) (Route b) -> Boom (Route b) (Route c) -> Boom (Route a) (Route c)
f </> g = f >>> eos >>> g

eos :: Boom (Route r) (Route r)
eos = mkPure $ Boom from to
  where
    from []      = Nothing
    from ("":xs) = Just xs
    from _       = Nothing
    to l = Just $ [""] ++ l

main = putStrLn "Hello"

sb.purs

module Main where

import Control.Bind
import Control.Apply

import Data.Char
import Data.String (length, drop)
import Data.Maybe
import Data.Tuple

type URL = [String]
type Route a = Tuple URL a

data Boom a b = Boom (a -> Maybe b) (b -> Maybe a)

inverse :: forall a b. Boom a b -> Boom b a
inverse (Boom f g) = Boom g f

apply :: forall a b. Boom a b -> a -> Maybe b
apply (Boom f g) = f

unapply :: forall a b. Boom a b -> b -> Maybe a
unapply (Boom f g) = g

instance boomSemigroupoid :: Semigroupoid Boom where
  (<<<) g f = Boom (apply f   >=> apply g)
                   (unapply g >=> unapply f)

instance boomCategory :: Category Boom where
  id = Boom Just Just

mkPure :: forall r. Boom URL URL -> Boom (Route r) (Route r)
mkPure (Boom from to) = Boom from' to'
  where
    comb b = (\a -> Tuple a b)
    from' = (\(Tuple url raw) -> (comb raw) <$> from url)
    to'   = (\(Tuple url raw) -> (comb raw) <$> to   url)

lit :: forall r. String -> Boom (Route r) (Route r)
lit s = mkPure $ Boom from to
  where
    from []     = Nothing
    from (x:xs) = case stripPrefix s x of
                    Nothing -> Nothing
                    Just x' -> Just (x':xs)
    to (x:xs) = Just $ (s ++ x):xs

anyString :: forall r. Boom (Route r) (Route (Tuple String r))
anyString = Boom from to
  where
    from (Tuple [] raw) = Nothing
    from (Tuple (x:xs) raw)
      | length x == 0   = Nothing
      | otherwise       = Just $ Tuple ("":xs) (Tuple x raw)
    to (Tuple (x:xs) (Tuple s r)) = Just $ Tuple ((x <> s):xs) r

infixl 0 </>
(</>) :: forall a b c. Boom (Route a) (Route b) -> Boom (Route b) (Route c) -> Boom (Route a) (Route c)
(</>) f g = f >>> eos >>> g

eos :: forall r. Boom (Route r) (Route r)
eos = mkPure $ Boom from to
  where
    from []      = Nothing
    from ("":xs) = Just xs
    from _       = Nothing
    to l = Just $ [""] ++ l

foreign import isPrefix
  """
  function isPrefix (prefix) {
    return function (test) {
      var i = 0;
      while (i < prefix.length && i < test.length) {
        if (prefix[i] != test[i])
          return false;
        i ++;
      }
      if (i == prefix.length)
        return true;
      else
        return false;
    }
  }
  """ :: String -> String -> Boolean

stripPrefix :: String -> String -> Maybe String
stripPrefix p s =
  if isPrefix p s
    then Just $ drop (length p) s
    else Nothing

I'm writing my next bidirectional routing library and I want to name it purescript-boomboom. Would you mind (I'm going to add you to Credits section ;-)) if I do this?