simplified boomerang in Haskell and PureScript

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"