public
Created — forked from tailcalled/Parser.hs

Stuff

  • Download Gist
Parser.hs
Haskell
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41
module Parser
import ImaginaryTTXTParser
import Data.Map
 
data Serve = Redirect String | FSDirectory String deriving (Show) -- Strings for simplification
 
data ConfigFile = ConfigFile (Map String Serve) deriving (Show)
 
vhosts (ConfigFile vhosts') = vhosts'
 
parseConfigFile :: TTXT -> Maybe ConfigFile
parseConfigFile ttxt = (ConfigFile . fromList) <$> (getOnly "vhosts" ttxt >>= parseVHosts)
 
parseVHosts :: [TTXT] -> Maybe [(String, Serve)]
parseVHosts ttxt = join $ join $ map optionToList $ map parseVHost ttxt
 
parseVHost :: TTXT -> Maybe [(String, Serve)]
parseVHost ttxt@(TTXT name _) =
do serve <- getVHostServe ttxt
let main = (name, serve)
(TTXT _ aliases) <- getOnly "aliases" ttxt
let aliases' = map ((, serve) . name) aliases
(TTXT _ redirects) <- getOnly "redirects" ttxt
let redirects' = map ((, Redirect name) . name) redirects
return $ main ++ aliases' ++ redirects'
 
getVHostServes :: TTXT -> Maybe Serve
getVHostServes ttxt =
do serve <- getOnly "serve" ttxt
if not $ hasChildren serve
then FSDirectory $ name serve
else primitiveMakeServe ttxt
 
primitiveMakeServe :: TTXT -> Maybe Serve
primitiveMakeServe (TTXT "FSDirectory" [TTXT dir []]) = Just $ FSDirectory dir
primitiveMakeServe (TTXT "Redirect" [TTXT url []]) = Just $ Redirect url
primitiveMakeServe _ = Nothing
 
main =
do ttxt <- ttxtFromFile "config.ttxt"
print $ parseConfigFile ttxt
config.ttxt
1 2 3 4 5 6 7 8
vhosts
nullable.se
aliases nullable.dk.dev
nullable.se.dev
redirect
www.nullable.se
serve
/var/www

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.