{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}

module Program.Mighty.Route (
    -- * Paring a routing file
    parseRoute,

    -- * Types
    RouteDB,
    Route (..),
    Block (..),
    Src,
    Dst,
    Domain,
    Port,

    -- * RouteDBRef
    RouteDBRef,
    newRouteDBRef,
    readRouteDBRef,
    writeRouteDBRef,
) where

import Control.Monad
import Data.ByteString
import qualified Data.ByteString.Char8 as BS
import Data.IORef
#ifdef DHALL
import GHC.Natural (Natural)
#endif
import Network.Wai.Application.Classic
import Text.Parsec
import Text.Parsec.ByteString.Lazy

import Program.Mighty.Parser

----------------------------------------------------------------

-- | A logical path specified in URL.
type Src = Path

-- | A physical path in a file system.
type Dst = Path

type Domain = ByteString
#ifdef DHALL
type Port     = Natural
#else
type Port     = Int
#endif

data Block = Block [Domain] [Route] deriving (Block -> Block -> Bool
(Block -> Block -> Bool) -> (Block -> Block -> Bool) -> Eq Block
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Block -> Block -> Bool
== :: Block -> Block -> Bool
$c/= :: Block -> Block -> Bool
/= :: Block -> Block -> Bool
Eq, Int -> Block -> ShowS
[Block] -> ShowS
Block -> String
(Int -> Block -> ShowS)
-> (Block -> String) -> ([Block] -> ShowS) -> Show Block
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Block -> ShowS
showsPrec :: Int -> Block -> ShowS
$cshow :: Block -> String
show :: Block -> String
$cshowList :: [Block] -> ShowS
showList :: [Block] -> ShowS
Show)
data Route
    = RouteFile Src Dst
    | RouteRedirect Src Dst
    | RouteCGI Src Dst
    | RouteRevProxy Src Dst Domain Port
    deriving (Route -> Route -> Bool
(Route -> Route -> Bool) -> (Route -> Route -> Bool) -> Eq Route
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Route -> Route -> Bool
== :: Route -> Route -> Bool
$c/= :: Route -> Route -> Bool
/= :: Route -> Route -> Bool
Eq, Int -> Route -> ShowS
[Route] -> ShowS
Route -> String
(Int -> Route -> ShowS)
-> (Route -> String) -> ([Route] -> ShowS) -> Show Route
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Route -> ShowS
showsPrec :: Int -> Route -> ShowS
$cshow :: Route -> String
show :: Route -> String
$cshowList :: [Route] -> ShowS
showList :: [Route] -> ShowS
Show)
type RouteDB = [Block]

----------------------------------------------------------------

-- | Parsing a route file.
parseRoute
    :: FilePath
    -> Domain
    -- ^ A default domain, typically \"localhost\"
    -> Port
    -- ^ A default port, typically 80.
    -> IO RouteDB
parseRoute :: String -> Domain -> Int -> IO [Block]
parseRoute String
file Domain
ddom Int
dport = Parser [Block] -> String -> IO [Block]
forall a. Parser a -> String -> IO a
parseFile (Domain -> Int -> Parser [Block]
routeDB Domain
ddom Int
dport) String
file

routeDB :: Domain -> Port -> Parser RouteDB
routeDB :: Domain -> Int -> Parser [Block]
routeDB Domain
ddom Int
dport = Parser ()
commentLines Parser () -> Parser [Block] -> Parser [Block]
forall a b.
ParsecT ByteString () Identity a
-> ParsecT ByteString () Identity b
-> ParsecT ByteString () Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT ByteString () Identity Block -> Parser [Block]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (Domain -> Int -> ParsecT ByteString () Identity Block
block Domain
ddom Int
dport) Parser [Block] -> Parser () -> Parser [Block]
forall a b.
ParsecT ByteString () Identity a
-> ParsecT ByteString () Identity b
-> ParsecT ByteString () Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof

block :: Domain -> Port -> Parser Block
block :: Domain -> Int -> ParsecT ByteString () Identity Block
block Domain
ddom Int
dport = [Domain] -> [Route] -> Block
Block ([Domain] -> [Route] -> Block)
-> ParsecT ByteString () Identity [Domain]
-> ParsecT ByteString () Identity ([Route] -> Block)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT ByteString () Identity [Domain]
cdomains ParsecT ByteString () Identity ([Route] -> Block)
-> ParsecT ByteString () Identity [Route]
-> ParsecT ByteString () Identity Block
forall a b.
ParsecT ByteString () Identity (a -> b)
-> ParsecT ByteString () Identity a
-> ParsecT ByteString () Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT ByteString () Identity Route
-> ParsecT ByteString () Identity [Route]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT ByteString () Identity Route
croute
  where
    cdomains :: ParsecT ByteString () Identity [Domain]
cdomains = ParsecT ByteString () Identity [Domain]
domains ParsecT ByteString () Identity [Domain]
-> Parser () -> ParsecT ByteString () Identity [Domain]
forall a b.
ParsecT ByteString () Identity a
-> ParsecT ByteString () Identity b
-> ParsecT ByteString () Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
commentLines
    croute :: ParsecT ByteString () Identity Route
croute = Domain -> Int -> ParsecT ByteString () Identity Route
route Domain
ddom Int
dport ParsecT ByteString () Identity Route
-> Parser () -> ParsecT ByteString () Identity Route
forall a b.
ParsecT ByteString () Identity a
-> ParsecT ByteString () Identity b
-> ParsecT ByteString () Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
commentLines

domains :: Parser [Domain]
domains :: ParsecT ByteString () Identity [Domain]
domains = Parser ()
open Parser ()
-> ParsecT ByteString () Identity [Domain]
-> ParsecT ByteString () Identity [Domain]
forall a b.
ParsecT ByteString () Identity a
-> ParsecT ByteString () Identity b
-> ParsecT ByteString () Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT ByteString () Identity [Domain]
doms ParsecT ByteString () Identity [Domain]
-> Parser () -> ParsecT ByteString () Identity [Domain]
forall a b.
ParsecT ByteString () Identity a
-> ParsecT ByteString () Identity b
-> ParsecT ByteString () Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
close ParsecT ByteString () Identity [Domain]
-> Parser () -> ParsecT ByteString () Identity [Domain]
forall a b.
ParsecT ByteString () Identity a
-> ParsecT ByteString () Identity b
-> ParsecT ByteString () Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
trailing
  where
    open :: Parser ()
open = () () -> ParsecT ByteString () Identity Char -> Parser ()
forall a b.
a
-> ParsecT ByteString () Identity b
-> ParsecT ByteString () Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT ByteString () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'[' Parser () -> Parser () -> Parser ()
forall a b.
ParsecT ByteString () Identity a
-> ParsecT ByteString () Identity b
-> ParsecT ByteString () Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
spcs
    close :: Parser ()
close = () () -> ParsecT ByteString () Identity Char -> Parser ()
forall a b.
a
-> ParsecT ByteString () Identity b
-> ParsecT ByteString () Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT ByteString () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
']' Parser () -> Parser () -> Parser ()
forall a b.
ParsecT ByteString () Identity a
-> ParsecT ByteString () Identity b
-> ParsecT ByteString () Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
spcs
    doms :: ParsecT ByteString () Identity [Domain]
doms = (ParsecT ByteString () Identity Domain
forall {u}. ParsecT ByteString u Identity Domain
domain ParsecT ByteString () Identity Domain
-> Parser () -> ParsecT ByteString () Identity [Domain]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
`sepBy1` Parser ()
sep) ParsecT ByteString () Identity [Domain]
-> Parser () -> ParsecT ByteString () Identity [Domain]
forall a b.
ParsecT ByteString () Identity a
-> ParsecT ByteString () Identity b
-> ParsecT ByteString () Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
spcs
    domain :: ParsecT ByteString u Identity Domain
domain = String -> Domain
BS.pack (String -> Domain)
-> ParsecT ByteString u Identity String
-> ParsecT ByteString u Identity Domain
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT ByteString u Identity Char
-> ParsecT ByteString u Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (String -> ParsecT ByteString u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf String
"[], \t\n")
    sep :: Parser ()
sep = () () -> Parser () -> Parser ()
forall a b.
a
-> ParsecT ByteString () Identity b
-> ParsecT ByteString () Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
spcs1

data Op = OpFile | OpCGI | OpRevProxy | OpRedirect

route :: Domain -> Port -> Parser Route
route :: Domain -> Int -> ParsecT ByteString () Identity Route
route Domain
ddom Int
dport = do
    Domain
s <- ParsecT ByteString () Identity Domain
src
    Op
o <- ParsecT ByteString () Identity Op
op
    case Op
o of
        Op
OpFile -> Domain -> Domain -> Route
RouteFile Domain
s (Domain -> Route)
-> ParsecT ByteString () Identity Domain
-> ParsecT ByteString () Identity Route
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT ByteString () Identity Domain
dst ParsecT ByteString () Identity Route
-> Parser () -> ParsecT ByteString () Identity Route
forall a b.
ParsecT ByteString () Identity a
-> ParsecT ByteString () Identity b
-> ParsecT ByteString () Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
trailing
        Op
OpRedirect -> Domain -> Domain -> Route
RouteRedirect Domain
s (Domain -> Route)
-> ParsecT ByteString () Identity Domain
-> ParsecT ByteString () Identity Route
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT ByteString () Identity Domain
dst' ParsecT ByteString () Identity Route
-> Parser () -> ParsecT ByteString () Identity Route
forall a b.
ParsecT ByteString () Identity a
-> ParsecT ByteString () Identity b
-> ParsecT ByteString () Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
trailing
        Op
OpCGI -> Domain -> Domain -> Route
RouteCGI Domain
s (Domain -> Route)
-> ParsecT ByteString () Identity Domain
-> ParsecT ByteString () Identity Route
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT ByteString () Identity Domain
dst ParsecT ByteString () Identity Route
-> Parser () -> ParsecT ByteString () Identity Route
forall a b.
ParsecT ByteString () Identity a
-> ParsecT ByteString () Identity b
-> ParsecT ByteString () Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
trailing
        Op
OpRevProxy -> do
            (Domain
dom, Int
prt, Domain
d) <- Domain -> Int -> Parser (Domain, Int, Domain)
domPortDst Domain
ddom Int
dport
            Route -> ParsecT ByteString () Identity Route
forall a. a -> ParsecT ByteString () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Route -> ParsecT ByteString () Identity Route)
-> Route -> ParsecT ByteString () Identity Route
forall a b. (a -> b) -> a -> b
$ Domain -> Domain -> Domain -> Int -> Route
RouteRevProxy Domain
s Domain
d Domain
dom Int
prt
  where
    src :: ParsecT ByteString () Identity Domain
src = ParsecT ByteString () Identity Domain
path
    dst :: ParsecT ByteString () Identity Domain
dst = ParsecT ByteString () Identity Domain
path
    dst' :: ParsecT ByteString () Identity Domain
dst' = ParsecT ByteString () Identity Domain
path'
    op0 :: ParsecT ByteString u Identity Op
op0 =
        Op
OpFile Op
-> ParsecT ByteString u Identity String
-> ParsecT ByteString u Identity Op
forall a b.
a
-> ParsecT ByteString u Identity b
-> ParsecT ByteString u Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ParsecT ByteString u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"->"
            ParsecT ByteString u Identity Op
-> ParsecT ByteString u Identity Op
-> ParsecT ByteString u Identity Op
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Op
OpRedirect Op
-> ParsecT ByteString u Identity String
-> ParsecT ByteString u Identity Op
forall a b.
a
-> ParsecT ByteString u Identity b
-> ParsecT ByteString u Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ParsecT ByteString u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"<<"
            ParsecT ByteString u Identity Op
-> ParsecT ByteString u Identity Op
-> ParsecT ByteString u Identity Op
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Op
OpCGI Op
-> ParsecT ByteString u Identity String
-> ParsecT ByteString u Identity Op
forall a b.
a
-> ParsecT ByteString u Identity b
-> ParsecT ByteString u Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ParsecT ByteString u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"=>"
            ParsecT ByteString u Identity Op
-> ParsecT ByteString u Identity Op
-> ParsecT ByteString u Identity Op
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Op
OpRevProxy Op
-> ParsecT ByteString u Identity String
-> ParsecT ByteString u Identity Op
forall a b.
a
-> ParsecT ByteString u Identity b
-> ParsecT ByteString u Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ParsecT ByteString u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
">>"
    op :: ParsecT ByteString () Identity Op
op = ParsecT ByteString () Identity Op
forall {u}. ParsecT ByteString u Identity Op
op0 ParsecT ByteString () Identity Op
-> Parser () -> ParsecT ByteString () Identity Op
forall a b.
ParsecT ByteString () Identity a
-> ParsecT ByteString () Identity b
-> ParsecT ByteString () Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
spcs

path :: Parser Path
path :: ParsecT ByteString () Identity Domain
path = do
    Char
c <- Char -> ParsecT ByteString () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'/'
    String -> Domain
BS.pack (String -> Domain) -> ShowS -> String -> Domain
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
c Char -> ShowS
forall a. a -> [a] -> [a]
:) (String -> Domain)
-> ParsecT ByteString () Identity String
-> ParsecT ByteString () Identity Domain
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT ByteString () Identity Char
-> ParsecT ByteString () Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (String -> ParsecT ByteString () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf String
"[], \t\n") ParsecT ByteString () Identity Domain
-> Parser () -> ParsecT ByteString () Identity Domain
forall a b.
ParsecT ByteString () Identity a
-> ParsecT ByteString () Identity b
-> ParsecT ByteString () Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
spcs

path' :: Parser Path
path' :: ParsecT ByteString () Identity Domain
path' = String -> Domain
BS.pack (String -> Domain)
-> ParsecT ByteString () Identity String
-> ParsecT ByteString () Identity Domain
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT ByteString () Identity Char
-> ParsecT ByteString () Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (String -> ParsecT ByteString () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf String
"[], \t\n") ParsecT ByteString () Identity Domain
-> Parser () -> ParsecT ByteString () Identity Domain
forall a b.
ParsecT ByteString () Identity a
-> ParsecT ByteString () Identity b
-> ParsecT ByteString () Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
spcs

-- [host1][:port2]/path2

domPortDst :: Domain -> Port -> Parser (Domain, Port, Dst)
domPortDst :: Domain -> Int -> Parser (Domain, Int, Domain)
domPortDst Domain
ddom Int
dport =
    (Domain
ddom,,) (Int -> Domain -> (Domain, Int, Domain))
-> ParsecT ByteString () Identity Int
-> ParsecT ByteString () Identity (Domain -> (Domain, Int, Domain))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT ByteString () Identity Int
forall {u}. ParsecT ByteString u Identity Int
port ParsecT ByteString () Identity (Domain -> (Domain, Int, Domain))
-> ParsecT ByteString () Identity Domain
-> Parser (Domain, Int, Domain)
forall a b.
ParsecT ByteString () Identity (a -> b)
-> ParsecT ByteString () Identity a
-> ParsecT ByteString () Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT ByteString () Identity Domain
path
        Parser (Domain, Int, Domain)
-> Parser (Domain, Int, Domain) -> Parser (Domain, Int, Domain)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser (Domain, Int, Domain) -> Parser (Domain, Int, Domain)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ((,,) (Domain -> Int -> Domain -> (Domain, Int, Domain))
-> ParsecT ByteString () Identity Domain
-> ParsecT
     ByteString () Identity (Int -> Domain -> (Domain, Int, Domain))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT ByteString () Identity Domain
forall {u}. ParsecT ByteString u Identity Domain
domain ParsecT
  ByteString () Identity (Int -> Domain -> (Domain, Int, Domain))
-> ParsecT ByteString () Identity Int
-> ParsecT ByteString () Identity (Domain -> (Domain, Int, Domain))
forall a b.
ParsecT ByteString () Identity (a -> b)
-> ParsecT ByteString () Identity a
-> ParsecT ByteString () Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT ByteString () Identity Int
forall {u}. ParsecT ByteString u Identity Int
port ParsecT ByteString () Identity (Domain -> (Domain, Int, Domain))
-> ParsecT ByteString () Identity Domain
-> Parser (Domain, Int, Domain)
forall a b.
ParsecT ByteString () Identity (a -> b)
-> ParsecT ByteString () Identity a
-> ParsecT ByteString () Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT ByteString () Identity Domain
path)
        Parser (Domain, Int, Domain)
-> Parser (Domain, Int, Domain) -> Parser (Domain, Int, Domain)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (,Int
dport,) (Domain -> Domain -> (Domain, Int, Domain))
-> ParsecT ByteString () Identity Domain
-> ParsecT ByteString () Identity (Domain -> (Domain, Int, Domain))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT ByteString () Identity Domain
forall {u}. ParsecT ByteString u Identity Domain
domain ParsecT ByteString () Identity (Domain -> (Domain, Int, Domain))
-> ParsecT ByteString () Identity Domain
-> Parser (Domain, Int, Domain)
forall a b.
ParsecT ByteString () Identity (a -> b)
-> ParsecT ByteString () Identity a
-> ParsecT ByteString () Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT ByteString () Identity Domain
path
  where
    domain :: ParsecT ByteString u Identity Domain
domain = String -> Domain
BS.pack (String -> Domain)
-> ParsecT ByteString u Identity String
-> ParsecT ByteString u Identity Domain
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT ByteString u Identity Char
-> ParsecT ByteString u Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (String -> ParsecT ByteString u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf String
":/[], \t\n")
    port :: ParsecT ByteString u Identity Int
port = do
        ParsecT ByteString u Identity Char
-> ParsecT ByteString u Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT ByteString u Identity Char
 -> ParsecT ByteString u Identity ())
-> ParsecT ByteString u Identity Char
-> ParsecT ByteString u Identity ()
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT ByteString u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
':'
        String -> Int
forall a. Read a => String -> a
read (String -> Int)
-> ParsecT ByteString u Identity String
-> ParsecT ByteString u Identity Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT ByteString u Identity Char
-> ParsecT ByteString u Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (String -> ParsecT ByteString u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf [Char
'0' .. Char
'9'])

----------------------------------------------------------------

newtype RouteDBRef = RouteDBRef (IORef RouteDB)

newRouteDBRef :: RouteDB -> IO RouteDBRef
newRouteDBRef :: [Block] -> IO RouteDBRef
newRouteDBRef [Block]
rout = IORef [Block] -> RouteDBRef
RouteDBRef (IORef [Block] -> RouteDBRef)
-> IO (IORef [Block]) -> IO RouteDBRef
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Block] -> IO (IORef [Block])
forall a. a -> IO (IORef a)
newIORef [Block]
rout

readRouteDBRef :: RouteDBRef -> IO RouteDB
readRouteDBRef :: RouteDBRef -> IO [Block]
readRouteDBRef (RouteDBRef IORef [Block]
ref) = IORef [Block] -> IO [Block]
forall a. IORef a -> IO a
readIORef IORef [Block]
ref

writeRouteDBRef :: RouteDBRef -> RouteDB -> IO ()
writeRouteDBRef :: RouteDBRef -> [Block] -> IO ()
writeRouteDBRef (RouteDBRef IORef [Block]
ref) [Block]
rout = IORef [Block] -> [Block] -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef [Block]
ref [Block]
rout