"Router as number" prototype

router.hs

import Control.Monad

rest name nested = resource name  -- /users/...
                 * (root          -- /users/
                 + identifier     -- /users/5/...
                   * (root        -- /users/5/
                   + end "show"   -- /users/5/show
                   + end "edit"   -- /users/5/edit
                   + nested))     -- /users/5/key/5/<...>

term name     = rest name nothing
bush name sub = rest name sub

router = root
       + term "users" 
       + bush "projects" 
           (term "keys"
          + term "locales")

requests = [["users", "5", "show"],
            ["users", "5", "edit"],
            ["users", "5"],
            ["usirs", "5", "show"],
            ["users"],
            [],
            ["projects", "secret", "show"],
            ["projects", "secret", "edit"],
            ["projects", "public"],
            ["projicts", "public", "show"],
            ["projects"],

            ["cucumbers", "1", "show"],
            ["cucumbers", "2", "edit"],
            ["cucumbers", "3"],

            ["projects", "secret", "keys",    "login", "edit"],
            ["projects", "secret", "locales", "ru_RU", "show"]]

main = mapM_ (print . route router) requests

{-
Should print:

Just 200: [users,#5,show]
Just 200: [users,#5,edit]
Just 200: [users,#5]
Nothing
Just 200: [users]
Just 200: []
Just 200: [projects,#secret,show]
Just 200: [projects,#secret,edit]
Just 200: [projects,#public]
Nothing
Just 200: [projects]
Nothing
Nothing
Nothing
Just 200: [projects,#secret,keys,#login,edit]
Just 200: [projects,#secret,locales,#ru_RU,show]


-}

data RoutingState = RoutingState { path   :: [Element]
                                 , parsed :: [Id]      }

type Element = String

data Id = Slug  { slug  :: String  }
        | Const { table :: String  }

data Response = Response { code     :: Integer
                         , response :: String }
      
instance Show Response where
  show result = show (code result) ++ ": " 
             ++ response result

instance Show Id where
  show (Slug  slug)  = "#" ++ slug
  show (Const const) = const

{- 
| The idea is: there is an routing tree, which has nodes and leaves:
    node :: state -> state?
    leaf :: state -> response?

    ("?" means nullability)

    We have two operators:
      node * node -> node,
      node * leaf -> leaf;
    and
      leaf + leaf -> leaf.

    Obviously, each multiplication chain must end with^W^W be a leaf, 
    because only leaf could produce response - the node is a service object
    made to pre-change the state of routing;

    otherwise, you will have an runtime error accessing this branch.
-}
data Router = RouterNode (RoutingState -> Maybe RoutingState)
            | RouterLeaf (RoutingState -> Maybe Response)

instance Num Router where
  RouterNode granny * RouterNode mother   = RouterNode $ granny >=> mother
  RouterNode mother * RouterLeaf daughter = RouterLeaf $ mother >=> daughter

  RouterLeaf left   + RouterLeaf right    = RouterLeaf $ first_succsessful [left, right]

first_succsessful []             = \state -> Nothing
first_succsessful (action: rest) = \state -> msum [action state, first_succsessful rest state]

resource name = RouterNode $ \state ->
                  case path state of
                    (top: rest) ->
                      if name == top
                        then let new_path = tail (path state)
                                 new_parsed = parsed state ++ [Const name]
                             in  Just $ RoutingState new_path new_parsed
                        else Nothing
                    _ -> Nothing

root = RouterLeaf $ \state -> 
         if path state == []
           then Just $ dump state
           else Nothing

identifier = RouterNode $ \state ->
               case path state of
                 (id: rest) -> let new_parsed = parsed state ++ [Slug id]
                               in  Just $ RoutingState rest new_parsed
                 _          -> Nothing

end point = RouterLeaf $ \state -> 
              if [point] == path state
                then let new_parsed = parsed state ++ [Const point]
                         new_state  = RoutingState [] new_parsed
                     in Just $ dump new_state
                else Nothing

route (RouterLeaf router) path = router $ RoutingState path []

dump state = Response 200 $ show (parsed state)

nothing = RouterLeaf $ \state -> Nothing