only rewrite routes if LOCALHOST env variable is unset
This commit is contained in:
parent
6bb3dbaef7
commit
b8e947fea4
330
src/Main.hs
330
src/Main.hs
@ -39,6 +39,8 @@ import Data.Void
|
||||
|
||||
import Network.URI
|
||||
|
||||
import System.Environment (lookupEnv)
|
||||
|
||||
config :: Configuration
|
||||
config =
|
||||
defaultConfiguration
|
||||
@ -65,180 +67,184 @@ unwrapped :: Snapshot
|
||||
unwrapped = "unwrapped"
|
||||
|
||||
main :: IO ()
|
||||
main = hakyllWith config $ do
|
||||
frontendManifest <-
|
||||
preprocess $
|
||||
Yaml.decodeFileThrow @_ @(Map String [FilePath]) "frontend/dist/.manifest.yaml"
|
||||
let
|
||||
frontendContext = jsContext <> cssContext
|
||||
where
|
||||
cssContext = listField "css" innerContext genCSSItems
|
||||
where
|
||||
innerContext = urlField "url"
|
||||
genCSSItems = genManifestItems $ Glob.compile "**/*.css"
|
||||
jsContext = listField "js" innerContext genCSSItems
|
||||
where
|
||||
innerContext = urlField "url"
|
||||
genCSSItems = genManifestItems $ Glob.compile "**/*.js"
|
||||
|
||||
genManifestItems :: Glob.Pattern -> Compiler [Item CopyFile]
|
||||
genManifestItems p = do
|
||||
let entryPoint = "main"
|
||||
resources = filter (Glob.match p) $ frontendManifest Map.! entryPoint
|
||||
forM resources $ load . fromFilePath . ("frontend/dist" </>) . dropDrive
|
||||
|
||||
netlifyRedirects <-
|
||||
preprocess . handleIf isDoesNotExistError (const $ return []) $
|
||||
let pNetlify :: ParsecT Void Lazy.Text m [(FilePath, FilePath)]
|
||||
pNetlify = catMaybes <$> MP.sepBy (MP.space *> pLine <* MP.hspace) pEOL <* MP.eof
|
||||
main =
|
||||
lookupEnv "LOCALHOST" >>= \((Nothing /=) -> localhost) -> hakyllWith config $ do
|
||||
frontendManifest <-
|
||||
preprocess $
|
||||
Yaml.decodeFileThrow @_ @(Map String [FilePath]) "frontend/dist/.manifest.yaml"
|
||||
let
|
||||
frontendContext = jsContext <> cssContext
|
||||
where
|
||||
cssContext = listField "css" innerContext genCSSItems
|
||||
where
|
||||
pEOL :: ParsecT Void Lazy.Text m ()
|
||||
pEOL = void . MP.label "linebreak" $ MP.eol
|
||||
pLine :: ParsecT Void Lazy.Text m (Maybe (FilePath, FilePath))
|
||||
pLine = MP.label "line" $ (mempty <$ pComment) <|> pRedirect <|> pure Nothing
|
||||
pComment :: ParsecT Void Lazy.Text m ()
|
||||
pComment = void $ MP.char '#' *> MP.label "comment" (MP.manyTill MP.anySingle $ MP.lookAhead MP.eol)
|
||||
pRedirect :: ParsecT Void Lazy.Text m (Maybe (FilePath, FilePath))
|
||||
pRedirect = do
|
||||
fromRoute <- MP.label "fromRoute" $ MP.manyTill MP.anySingle MP.separatorChar
|
||||
MP.hspace
|
||||
toRoute <- MP.label "toRoute" $ MP.manyTill MP.anySingle MP.separatorChar
|
||||
MP.hspace
|
||||
redirectMode <- MP.label "mode" $ asum [MP.string "200", MP.string "301", MP.string "302"]
|
||||
return $
|
||||
if
|
||||
| redirectMode == "200" -> Just (fromRoute, toRoute)
|
||||
| otherwise -> Nothing
|
||||
in either throwIO return =<< MP.runParserT pNetlify "static/_redirects" =<< LT.readFile "static/_redirects"
|
||||
let
|
||||
renderRoute r
|
||||
| fromRoute : _ <- mapMaybe (matchNetlifyRedirect r) netlifyRedirects =
|
||||
fromRoute
|
||||
| otherwise =
|
||||
r
|
||||
where
|
||||
matchNetlifyRedirect :: FilePath -> (FilePath, FilePath) -> Maybe FilePath
|
||||
matchNetlifyRedirect r' (fromRoute, toRoute) = do
|
||||
tokens <- MP.parseMaybe pToSpec toRoute
|
||||
Right subst <- return $ runReader (MP.runParserT (pRoute tokens <* MP.eof) "" r') Map.empty
|
||||
return . T.unpack $ Map.foldrWithKey doSubst (T.pack fromRoute) subst
|
||||
where
|
||||
pToSpec :: Parsec Void FilePath [Either FilePath String]
|
||||
pToSpec =
|
||||
MP.some $
|
||||
Left <$> MP.someTill (MP.anySingleBut ':') (MP.lookAhead $ MP.eof <|> void (MP.single ':'))
|
||||
<|> Right <$> (MP.char ':' *> MP.some MP.letterChar)
|
||||
pRoute :: [Either FilePath String] -> ParsecT Void FilePath (Reader (Map String String)) (Map String String)
|
||||
pRoute [] = MP.eof *> ask
|
||||
pRoute (t : ts) = case t of
|
||||
Left str -> MP.string str *> pRoute ts
|
||||
Right p -> do
|
||||
pVal <- asks $ Map.lookup p
|
||||
case pVal of
|
||||
Nothing -> do
|
||||
mLength <- length <$> MP.getInput
|
||||
asum . flip map [0 .. mLength] $ \l -> MP.try $ do
|
||||
val <- MP.takeP (Just $ ':' : p) l
|
||||
newSubst <- asks $ Map.insert p val
|
||||
newSubst <$ local (const newSubst) (pRoute ts)
|
||||
Just pVal' -> MP.string pVal' *> ask
|
||||
innerContext = urlField "url"
|
||||
genCSSItems = genManifestItems $ Glob.compile "**/*.css"
|
||||
jsContext = listField "js" innerContext genCSSItems
|
||||
where
|
||||
innerContext = urlField "url"
|
||||
genCSSItems = genManifestItems $ Glob.compile "**/*.js"
|
||||
|
||||
doSubst :: String -> String -> Text -> Text
|
||||
doSubst k s = T.intercalate (T.pack s) . T.splitOn (T.pack $ ':' : k)
|
||||
normalizeUrls :: Item String -> Compiler (Item String)
|
||||
normalizeUrls item = do
|
||||
itemRoute <- getRoute $ itemIdentifier item
|
||||
let relativizeUrls' x = case itemRoute of
|
||||
Just r
|
||||
| "/" `List.isPrefixOf` x && not ("//" `List.isPrefixOf` x) ->
|
||||
toSiteRoot r ++ x
|
||||
_other -> x
|
||||
overPath f str = case parseURIReference str of
|
||||
Nothing -> f str
|
||||
Just uri@URI{uriPath} -> uriToString id uri{uriPath = f uriPath} mempty
|
||||
return $ withUrls (relativizeUrls' . overPath renderRoute) <$> item
|
||||
genManifestItems :: Glob.Pattern -> Compiler [Item CopyFile]
|
||||
genManifestItems p = do
|
||||
let entryPoint = "main"
|
||||
resources = filter (Glob.match p) $ frontendManifest Map.! entryPoint
|
||||
forM resources $ load . fromFilePath . ("frontend/dist" </>) . dropDrive
|
||||
|
||||
tags <- buildTags "content/**" $ fromCapture "tags/*.html"
|
||||
netlifyRedirects <-
|
||||
if localhost
|
||||
then return []
|
||||
else
|
||||
preprocess . handleIf isDoesNotExistError (const $ return []) $
|
||||
let pNetlify :: ParsecT Void Lazy.Text m [(FilePath, FilePath)]
|
||||
pNetlify = catMaybes <$> MP.sepBy (MP.space *> pLine <* MP.hspace) pEOL <* MP.eof
|
||||
where
|
||||
pEOL :: ParsecT Void Lazy.Text m ()
|
||||
pEOL = void . MP.label "linebreak" $ MP.eol
|
||||
pLine :: ParsecT Void Lazy.Text m (Maybe (FilePath, FilePath))
|
||||
pLine = MP.label "line" $ (mempty <$ pComment) <|> pRedirect <|> pure Nothing
|
||||
pComment :: ParsecT Void Lazy.Text m ()
|
||||
pComment = void $ MP.char '#' *> MP.label "comment" (MP.manyTill MP.anySingle $ MP.lookAhead MP.eol)
|
||||
pRedirect :: ParsecT Void Lazy.Text m (Maybe (FilePath, FilePath))
|
||||
pRedirect = do
|
||||
fromRoute <- MP.label "fromRoute" $ MP.manyTill MP.anySingle MP.separatorChar
|
||||
MP.hspace
|
||||
toRoute <- MP.label "toRoute" $ MP.manyTill MP.anySingle MP.separatorChar
|
||||
MP.hspace
|
||||
redirectMode <- MP.label "mode" $ asum [MP.string "200", MP.string "301", MP.string "302"]
|
||||
return $
|
||||
if
|
||||
| redirectMode == "200" -> Just (fromRoute, toRoute)
|
||||
| otherwise -> Nothing
|
||||
in either throwIO return =<< MP.runParserT pNetlify "static/_redirects" =<< LT.readFile "static/_redirects"
|
||||
let
|
||||
renderRoute r
|
||||
| fromRoute : _ <- mapMaybe (matchNetlifyRedirect r) netlifyRedirects =
|
||||
fromRoute
|
||||
| otherwise =
|
||||
r
|
||||
where
|
||||
matchNetlifyRedirect :: FilePath -> (FilePath, FilePath) -> Maybe FilePath
|
||||
matchNetlifyRedirect r' (fromRoute, toRoute) = do
|
||||
tokens <- MP.parseMaybe pToSpec toRoute
|
||||
Right subst <- return $ runReader (MP.runParserT (pRoute tokens <* MP.eof) "" r') Map.empty
|
||||
return . T.unpack $ Map.foldrWithKey doSubst (T.pack fromRoute) subst
|
||||
where
|
||||
pToSpec :: Parsec Void FilePath [Either FilePath String]
|
||||
pToSpec =
|
||||
MP.some $
|
||||
Left <$> MP.someTill (MP.anySingleBut ':') (MP.lookAhead $ MP.eof <|> void (MP.single ':'))
|
||||
<|> Right <$> (MP.char ':' *> MP.some MP.letterChar)
|
||||
pRoute :: [Either FilePath String] -> ParsecT Void FilePath (Reader (Map String String)) (Map String String)
|
||||
pRoute [] = MP.eof *> ask
|
||||
pRoute (t : ts) = case t of
|
||||
Left str -> MP.string str *> pRoute ts
|
||||
Right p -> do
|
||||
pVal <- asks $ Map.lookup p
|
||||
case pVal of
|
||||
Nothing -> do
|
||||
mLength <- length <$> MP.getInput
|
||||
asum . flip map [0 .. mLength] $ \l -> MP.try $ do
|
||||
val <- MP.takeP (Just $ ':' : p) l
|
||||
newSubst <- asks $ Map.insert p val
|
||||
newSubst <$ local (const newSubst) (pRoute ts)
|
||||
Just pVal' -> MP.string pVal' *> ask
|
||||
|
||||
let
|
||||
applySiteLayout = loadAndApplyTemplate "templates/site-layout.html" . (<> ctx')
|
||||
where
|
||||
ctx' =
|
||||
mconcat
|
||||
[ listField "tags-nav" defaultContext (metadataSort <=< mapM (uncurry renderTagNav) $ tagsMap tags)
|
||||
, listField "special-nav" defaultContext $ metadataSort =<< mapM (flip loadSnapshot unwrapped) =<< getMatches (fromGlob "special/**")
|
||||
, frontendContext
|
||||
, defaultContext
|
||||
]
|
||||
renderTagNav tag' ids = do
|
||||
tagItems' <- getMatches . fromGlob $ toFilePath (tagsMakeId tags tag') -<.> "*"
|
||||
let
|
||||
tagItem' = return $ Item (fromMaybe (tagsMakeId tags tag') $ listToMaybe tagItems') (mempty :: String)
|
||||
doSubst :: String -> String -> Text -> Text
|
||||
doSubst k s = T.intercalate (T.pack s) . T.splitOn (T.pack $ ':' : k)
|
||||
normalizeUrls :: Item String -> Compiler (Item String)
|
||||
normalizeUrls item = do
|
||||
itemRoute <- getRoute $ itemIdentifier item
|
||||
let relativizeUrls' x = case itemRoute of
|
||||
Just r
|
||||
| "/" `List.isPrefixOf` x && not ("//" `List.isPrefixOf` x) ->
|
||||
toSiteRoot r ++ x
|
||||
_other -> x
|
||||
overPath f str = case parseURIReference str of
|
||||
Nothing -> f str
|
||||
Just uri@URI{uriPath} -> uriToString id uri{uriPath = f uriPath} mempty
|
||||
return $ withUrls (relativizeUrls' . overPath renderRoute) <$> item
|
||||
|
||||
navRoute = "/" <> tag' <> ".html"
|
||||
tags <- buildTags "content/**" $ fromCapture "tags/*.html"
|
||||
|
||||
tagNavCtx =
|
||||
mconcat
|
||||
[ constField "tag" tag'
|
||||
, field "title" . const $
|
||||
fmap (fromMaybe tag') . runMaybeT . asum $
|
||||
map (\itemId -> MaybeT $ getMetadataField itemId "title") tagItems'
|
||||
, constField "route" navRoute
|
||||
, listField "posts" (constField "tag" tag' <> constField "route" navRoute <> postContext) (metadataSort =<< mapM load ids)
|
||||
]
|
||||
tagItem'
|
||||
>>= loadAndApplyTemplate "templates/tag-nav.html" tagNavCtx
|
||||
>>= normalizeUrls
|
||||
postContext =
|
||||
mconcat
|
||||
[ field "identifier" (return . takeBaseName . toFilePath . itemIdentifier)
|
||||
, defaultContext
|
||||
]
|
||||
specialContext = defaultContext
|
||||
let
|
||||
applySiteLayout = loadAndApplyTemplate "templates/site-layout.html" . (<> ctx')
|
||||
where
|
||||
ctx' =
|
||||
mconcat
|
||||
[ listField "tags-nav" defaultContext (metadataSort <=< mapM (uncurry renderTagNav) $ tagsMap tags)
|
||||
, listField "special-nav" defaultContext $ metadataSort =<< mapM (flip loadSnapshot unwrapped) =<< getMatches (fromGlob "special/**")
|
||||
, frontendContext
|
||||
, defaultContext
|
||||
]
|
||||
renderTagNav tag' ids = do
|
||||
tagItems' <- getMatches . fromGlob $ toFilePath (tagsMakeId tags tag') -<.> "*"
|
||||
let
|
||||
tagItem' = return $ Item (fromMaybe (tagsMakeId tags tag') $ listToMaybe tagItems') (mempty :: String)
|
||||
|
||||
match "content/**" $ do
|
||||
compile $
|
||||
pandocCompiler
|
||||
>>= normalizeUrls
|
||||
navRoute = "/" <> tag' <> ".html"
|
||||
|
||||
match "special/**" $ do
|
||||
route . routeAsFilePath $ (-<.> "html") . stripPathPrefix "special"
|
||||
compile $
|
||||
pandocCompiler
|
||||
>>= saveSnapshot unwrapped
|
||||
>>= applySiteLayout specialContext
|
||||
>>= normalizeUrls
|
||||
tagNavCtx =
|
||||
mconcat
|
||||
[ constField "tag" tag'
|
||||
, field "title" . const $
|
||||
fmap (fromMaybe tag') . runMaybeT . asum $
|
||||
map (\itemId -> MaybeT $ getMetadataField itemId "title") tagItems'
|
||||
, constField "route" navRoute
|
||||
, listField "posts" (constField "tag" tag' <> constField "route" navRoute <> postContext) (metadataSort =<< mapM load ids)
|
||||
]
|
||||
tagItem'
|
||||
>>= loadAndApplyTemplate "templates/tag-nav.html" tagNavCtx
|
||||
>>= normalizeUrls
|
||||
postContext =
|
||||
mconcat
|
||||
[ field "identifier" (return . takeBaseName . toFilePath . itemIdentifier)
|
||||
, defaultContext
|
||||
]
|
||||
specialContext = defaultContext
|
||||
|
||||
forM_ (tagsMap tags) $ \(tag, fromList -> posts) ->
|
||||
rulesExtraDependencies [tagsDependency tags] $ do
|
||||
tagItems <- getMatches . fromGlob $ toFilePath (tagsMakeId tags tag) -<.> "*"
|
||||
let tagItem = pandocCompiler <|> makeItem mempty
|
||||
rule
|
||||
| [] <- tagItems = create [tagsMakeId tags tag]
|
||||
| otherwise = match (fromList tagItems)
|
||||
match "content/**" $ do
|
||||
compile $
|
||||
pandocCompiler
|
||||
>>= normalizeUrls
|
||||
|
||||
rule $ do
|
||||
route . routeAsFilePath $ (-<.> "html") . stripPathPrefix "tags"
|
||||
compile $ do
|
||||
let
|
||||
ctx =
|
||||
mconcat
|
||||
[ listField "posts" postContext (metadataSort =<< loadAll posts)
|
||||
, defaultContext
|
||||
]
|
||||
match "special/**" $ do
|
||||
route . routeAsFilePath $ (-<.> "html") . stripPathPrefix "special"
|
||||
compile $
|
||||
pandocCompiler
|
||||
>>= saveSnapshot unwrapped
|
||||
>>= applySiteLayout specialContext
|
||||
>>= normalizeUrls
|
||||
|
||||
tagItem
|
||||
>>= loadAndApplyTemplate "templates/tag.html" ctx
|
||||
>>= applySiteLayout ctx
|
||||
>>= normalizeUrls
|
||||
forM_ (tagsMap tags) $ \(tag, fromList -> posts) ->
|
||||
rulesExtraDependencies [tagsDependency tags] $ do
|
||||
tagItems <- getMatches . fromGlob $ toFilePath (tagsMakeId tags tag) -<.> "*"
|
||||
let tagItem = pandocCompiler <|> makeItem mempty
|
||||
rule
|
||||
| [] <- tagItems = create [tagsMakeId tags tag]
|
||||
| otherwise = match (fromList tagItems)
|
||||
|
||||
match "frontend/dist/wp-*/**" $ do
|
||||
route . routeAsFilePath $ stripPathPrefix "frontend/dist"
|
||||
rule $ do
|
||||
route . routeAsFilePath $ (-<.> "html") . stripPathPrefix "tags"
|
||||
compile $ do
|
||||
let
|
||||
ctx =
|
||||
mconcat
|
||||
[ listField "posts" postContext (metadataSort =<< loadAll posts)
|
||||
, defaultContext
|
||||
]
|
||||
|
||||
compile copyFileCompiler
|
||||
tagItem
|
||||
>>= loadAndApplyTemplate "templates/tag.html" ctx
|
||||
>>= applySiteLayout ctx
|
||||
>>= normalizeUrls
|
||||
|
||||
match "templates/*" $ compile templateBodyCompiler
|
||||
match "frontend/dist/wp-*/**" $ do
|
||||
route . routeAsFilePath $ stripPathPrefix "frontend/dist"
|
||||
|
||||
match "static/**" $ do
|
||||
route . routeAsFilePath $ stripPathPrefix "static"
|
||||
compile copyFileCompiler
|
||||
compile copyFileCompiler
|
||||
|
||||
match "templates/*" $ compile templateBodyCompiler
|
||||
|
||||
match "static/**" $ do
|
||||
route . routeAsFilePath $ stripPathPrefix "static"
|
||||
compile copyFileCompiler
|
||||
|
||||
Loading…
Reference in New Issue
Block a user