only rewrite routes if LOCALHOST env variable is unset

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
+main =
-  frontendManifest <-
+  lookupEnv "LOCALHOST" >>= \((Nothing /=) -> localhost) -> hakyllWith config $ do
-    preprocess $
+    frontendManifest <-
-      Yaml.decodeFileThrow @_ @(Map String [FilePath]) "frontend/dist/.manifest.yaml"
+      preprocess $
-  let
+        Yaml.decodeFileThrow @_ @(Map String [FilePath]) "frontend/dist/.manifest.yaml"
-    frontendContext = jsContext <> cssContext
+    let
-      where
+      frontendContext = jsContext <> cssContext
-        cssContext = listField "css" innerContext genCSSItems
+        where
-          where
+          cssContext = listField "css" innerContext genCSSItems
-            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
             where
-              pEOL :: ParsecT Void Lazy.Text m ()
+              innerContext = urlField "url"
-              pEOL = void . MP.label "linebreak" $ MP.eol
+              genCSSItems = genManifestItems $ Glob.compile "**/*.css"
-              pLine :: ParsecT Void Lazy.Text m (Maybe (FilePath, FilePath))
+          jsContext = listField "js" innerContext genCSSItems
-              pLine = MP.label "line" $ (mempty <$ pComment) <|> pRedirect <|> pure Nothing
+            where
-              pComment :: ParsecT Void Lazy.Text m ()
+              innerContext = urlField "url"
-              pComment = void $ MP.char '#' *> MP.label "comment" (MP.manyTill MP.anySingle $ MP.lookAhead MP.eol)
+              genCSSItems = genManifestItems $ Glob.compile "**/*.js"
-              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
 
-            doSubst :: String -> String -> Text -> Text
+          genManifestItems :: Glob.Pattern -> Compiler [Item CopyFile]
-            doSubst k s = T.intercalate (T.pack s) . T.splitOn (T.pack $ ':' : k)
+          genManifestItems p = do
-    normalizeUrls :: Item String -> Compiler (Item String)
+            let entryPoint = "main"
-    normalizeUrls item = do
+                resources = filter (Glob.match p) $ frontendManifest Map.! entryPoint
-      itemRoute <- getRoute $ itemIdentifier item
+            forM resources $ load . fromFilePath . ("frontend/dist" </>) . dropDrive
-      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
 
-  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
+              doSubst :: String -> String -> Text -> Text
-    applySiteLayout = loadAndApplyTemplate "templates/site-layout.html" . (<> ctx')
+              doSubst k s = T.intercalate (T.pack s) . T.splitOn (T.pack $ ':' : k)
-      where
+      normalizeUrls :: Item String -> Compiler (Item String)
-        ctx' =
+      normalizeUrls item = do
-          mconcat
+        itemRoute <- getRoute $ itemIdentifier item
-            [ listField "tags-nav" defaultContext (metadataSort <=< mapM (uncurry renderTagNav) $ tagsMap tags)
+        let relativizeUrls' x = case itemRoute of
-            , listField "special-nav" defaultContext $ metadataSort =<< mapM (flip loadSnapshot unwrapped) =<< getMatches (fromGlob "special/**")
+              Just r
-            , frontendContext
+                | "/" `List.isPrefixOf` x && not ("//" `List.isPrefixOf` x) ->
-            , defaultContext
+                    toSiteRoot r ++ x
-            ]
+              _other -> x
-        renderTagNav tag' ids = do
+            overPath f str = case parseURIReference str of
-          tagItems' <- getMatches . fromGlob $ toFilePath (tagsMakeId tags tag') -<.> "*"
+              Nothing -> f str
-          let
+              Just uri@URI{uriPath} -> uriToString id uri{uriPath = f uriPath} mempty
-            tagItem' = return $ Item (fromMaybe (tagsMakeId tags tag') $ listToMaybe tagItems') (mempty :: String)
+        return $ withUrls (relativizeUrls' . overPath renderRoute) <$> item
 
-            navRoute = "/" <> tag' <> ".html"
+    tags <- buildTags "content/**" $ fromCapture "tags/*.html"
 
-            tagNavCtx =
+    let
-              mconcat
+      applySiteLayout = loadAndApplyTemplate "templates/site-layout.html" . (<> ctx')
-                [ constField "tag" tag'
+        where
-                , field "title" . const $
+          ctx' =
-                    fmap (fromMaybe tag') . runMaybeT . asum $
+            mconcat
-                      map (\itemId -> MaybeT $ getMetadataField itemId "title") tagItems'
+              [ listField "tags-nav" defaultContext (metadataSort <=< mapM (uncurry renderTagNav) $ tagsMap tags)
-                , constField "route" navRoute
+              , listField "special-nav" defaultContext $ metadataSort =<< mapM (flip loadSnapshot unwrapped) =<< getMatches (fromGlob "special/**")
-                , listField "posts" (constField "tag" tag' <> constField "route" navRoute <> postContext) (metadataSort =<< mapM load ids)
+              , frontendContext
-                ]
+              , defaultContext
-          tagItem'
+              ]
-            >>= loadAndApplyTemplate "templates/tag-nav.html" tagNavCtx
+          renderTagNav tag' ids = do
-            >>= normalizeUrls
+            tagItems' <- getMatches . fromGlob $ toFilePath (tagsMakeId tags tag') -<.> "*"
-    postContext =
+            let
-      mconcat
+              tagItem' = return $ Item (fromMaybe (tagsMakeId tags tag') $ listToMaybe tagItems') (mempty :: String)
-        [ field "identifier" (return . takeBaseName . toFilePath . itemIdentifier)
-        , defaultContext
-        ]
-    specialContext = defaultContext
 
-  match "content/**" $ do
+              navRoute = "/" <> tag' <> ".html"
-    compile $
-      pandocCompiler
-        >>= normalizeUrls
 
-  match "special/**" $ do
+              tagNavCtx =
-    route . routeAsFilePath $ (-<.> "html") . stripPathPrefix "special"
+                mconcat
-    compile $
+                  [ constField "tag" tag'
-      pandocCompiler
+                  , field "title" . const $
-        >>= saveSnapshot unwrapped
+                      fmap (fromMaybe tag') . runMaybeT . asum $
-        >>= applySiteLayout specialContext
+                        map (\itemId -> MaybeT $ getMetadataField itemId "title") tagItems'
-        >>= normalizeUrls
+                  , 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) ->
+    match "content/**" $ do
-    rulesExtraDependencies [tagsDependency tags] $ do
+      compile $
-      tagItems <- getMatches . fromGlob $ toFilePath (tagsMakeId tags tag) -<.> "*"
+        pandocCompiler
-      let tagItem = pandocCompiler <|> makeItem mempty
+          >>= normalizeUrls
-          rule
-            | [] <- tagItems = create [tagsMakeId tags tag]
-            | otherwise = match (fromList tagItems)
 
-      rule $ do
+    match "special/**" $ do
-        route . routeAsFilePath $ (-<.> "html") . stripPathPrefix "tags"
+      route . routeAsFilePath $ (-<.> "html") . stripPathPrefix "special"
-        compile $ do
+      compile $
-          let
+        pandocCompiler
-            ctx =
+          >>= saveSnapshot unwrapped
-              mconcat
+          >>= applySiteLayout specialContext
-                [ listField "posts" postContext (metadataSort =<< loadAll posts)
+          >>= normalizeUrls
-                , defaultContext
-                ]
 
-          tagItem
+    forM_ (tagsMap tags) $ \(tag, fromList -> posts) ->
-            >>= loadAndApplyTemplate "templates/tag.html" ctx
+      rulesExtraDependencies [tagsDependency tags] $ do
-            >>= applySiteLayout ctx
+        tagItems <- getMatches . fromGlob $ toFilePath (tagsMakeId tags tag) -<.> "*"
-            >>= normalizeUrls
+        let tagItem = pandocCompiler <|> makeItem mempty
+            rule
+              | [] <- tagItems = create [tagsMakeId tags tag]
+              | otherwise = match (fromList tagItems)
 
-  match "frontend/dist/wp-*/**" $ do
+        rule $ do
-    route . routeAsFilePath $ stripPathPrefix "frontend/dist"
+          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
+      compile copyFileCompiler
-    route . routeAsFilePath $ stripPathPrefix "static"
+
-    compile copyFileCompiler
+    match "templates/*" $ compile templateBodyCompiler
+
+    match "static/**" $ do
+      route . routeAsFilePath $ stripPathPrefix "static"
+      compile copyFileCompiler