content: {-# LANGUAGE OverloadedStrings #-}
  {-# LANGUAGE ParallelListComp #-}
  {-# LANGUAGE PatternGuards #-}
  
  {-
    Copyright 2020 The CodeWorld Authors. All rights reserved.
  
    Licensed under the Apache License, Version 2.0 (the "License");
    you may not use this file except in compliance with the License.
    You may obtain a copy of the License at
  
        http://www.apache.org/licenses/LICENSE-2.0
  
    Unless required by applicable law or agreed to in writing, software
    distributed under the License is distributed on an "AS IS" BASIS,
    WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
    See the License for the specific language governing permissions and
    limitations under the License.
  -}
  
  module CodeWorld.Compile.Base (generateBaseBundle, baseVersion) where
  
  import Data.ByteString (ByteString)
  import qualified Data.ByteString as B
  import Data.Char
  import Data.Monoid
  import Data.Text (Text)
  import qualified Data.Text as T
  import qualified Data.Text.Encoding as T
  import qualified Data.Text.IO as T
  import System.Process
  import Text.Regex.TDFA
  import Text.Regex.TDFA.Text
  
  generateBaseBundle ::
    [FilePath] -> [Text] -> String -> FilePath -> FilePath -> IO ()
  generateBaseBundle hoogleDBs blacklist mode mainFile baseFile = do
    (imports, exprs) <- readHoogleDBs hoogleDBs blacklist
    let defs =
          [ "d" <> T.pack (show i) <> " = " <> e
            | i <- [0 :: Int ..]
            | e <- exprs
          ]
        src = T.unlines ("module LinkBase where" : imports ++ defs)
        mainDef =
          case mode of
            "codeworld" -> "program = drawingOf(blank)"
            _ -> "main = return ()"
    T.writeFile baseFile src
    T.writeFile mainFile $
      T.unlines ["module Main where", "import LinkBase", mainDef]
  
  readHoogleDBs :: [FilePath] -> [Text] -> IO ([Text], [Text])
  readHoogleDBs files blacklist = foldMap (flip readHoogleDB blacklist) files
  
  readHoogleDB :: FilePath -> [Text] -> IO ([Text], [Text])
  readHoogleDB file blacklist = do
    lns <- T.lines <$> T.readFile file
    return (parseHoogleDB blacklist Nothing lns)
  
  parseHoogleDB :: [Text] -> Maybe Text -> [Text] -> ([Text], [Text])
  parseHoogleDB blacklist _ (t : ts)
    | Just mod <- submatch t "^module ([A-Za-z0-9._']+)",
      not (mod `elem` blacklist) =
      let (i, e) = parseHoogleDB blacklist (Just mod) ts
       in ("import qualified " <> mod : i, e)
  parseHoogleDB blacklist (Just mod) (t : ts)
    | Just ident <- submatch t "^([A-Za-z0-9_']+) :: .*",
      not (ident `elem` blacklist) =
      let (i, e) = parseHoogleDB blacklist (Just mod) ts
       in (i, mod <> "." <> ident : e)
    | Just sym <- submatch t "^\\(([!#$%&*+./<=>?@\\\\^|-~]+)\\) :: .*",
      not (sym `elem` blacklist) =
      let (i, e) = parseHoogleDB blacklist (Just mod) ts
       in (i, "(" <> mod <> "." <> sym <> ")" : e)
  parseHoogleDB blacklist mmod (_ : ts) = parseHoogleDB blacklist mmod ts
  parseHoogleDB _ _ [] = ([], [])
  
  submatch :: Text -> Text -> Maybe Text
  submatch t pat
    | [_, match] <- getAllTextSubmatches (t =~ pat) = Just match
    | otherwise = Nothing
  
  baseVersion :: IO Text
  baseVersion = do
    (_, Just outh, _, pid) <-
      createProcess
        (shell "ghcjs-pkg list -v 2>&1 | sha256sum")
          { std_in = NoStream,
            std_out = CreatePipe,
            std_err = NoStream,
            close_fds = True
          }
    hash <- T.decodeUtf8 <$> B.takeWhile (/= fromIntegral (ord ' ')) <$> B.hGetContents outh
    waitForProcess pid
    return hash
  