{-# LANGUAGE OverloadedStrings #-}
module JS (
    generate
  ) where

import Data.Aeson (encode)

import Blog (Blog(..), Path(..))
import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad.Reader (ReaderT, asks)
import Data.ByteString.Lazy (
    ByteString, concat, intercalate, fromStrict, readFile, writeFile
  )
import Data.ByteString.Lazy.Char8 (pack)
import Data.Text.Encoding (encodeUtf8)
import JSON (exportBlog)
import Paths_hablo (getDataDir)
import Pretty ((.$))
import SJW (compile, source, sourceCode)
import System.Directory (createDirectoryIfMissing)
import System.Exit (die)
import System.FilePath ((</>))
import Prelude hiding (concat, readFile, writeFile)

object :: [ByteString] -> ByteString
object :: [ByteString] -> ByteString
object [ByteString]
sources = [ByteString] -> ByteString
concat [ByteString
header, ByteString -> [ByteString] -> ByteString
intercalate ByteString
",\n" [ByteString]
sources, ByteString
footer]
  where
    header :: ByteString
header = ByteString
"return {\n"
    footer :: ByteString
footer = ByteString
"\n};"

var :: (String, ByteString) -> ByteString
var :: (String, ByteString) -> ByteString
var (String
varName, ByteString
content) = [ByteString] -> ByteString
concat [ByteString
"\t", String -> ByteString
pack String
varName, ByteString
" : ", ByteString
content]

generateConfig :: FilePath -> ReaderT Blog IO ()
generateConfig :: String -> ReaderT Blog IO ()
generateConfig String
destinationDir = do
  ByteString
blogJSON <- (Blog -> ByteString) -> ReaderT Blog IO ByteString
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (BlogExport -> ByteString
forall a. ToJSON a => a -> ByteString
encode (BlogExport -> ByteString)
-> (Blog -> BlogExport) -> Blog -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Blog -> BlogExport
exportBlog)
  Maybe String
remarkablePath <- (Blog -> Maybe String) -> ReaderT Blog IO (Maybe String)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((Blog -> Maybe String) -> ReaderT Blog IO (Maybe String))
-> (Blog -> Maybe String) -> ReaderT Blog IO (Maybe String)
forall a b. (a -> b) -> a -> b
$Blog -> Path
path(Blog -> Path) -> (Path -> Maybe String) -> Blog -> Maybe String
forall a b c. (a -> b) -> (b -> c) -> a -> c
.$Path -> Maybe String
remarkableConfig
  IO () -> ReaderT Blog IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ReaderT Blog IO ()) -> IO () -> ReaderT Blog IO ()
forall a b. (a -> b) -> a -> b
$ do
    ByteString
remarkableJSON <- IO ByteString
-> (String -> IO ByteString) -> Maybe String -> IO ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
"{html: true}") String -> IO ByteString
readFile Maybe String
remarkablePath
    let jsVars :: [(String, ByteString)]
jsVars = [(String
"blog", ByteString
blogJSON), (String
"remarkableConfig", ByteString
remarkableJSON)]
    String -> ByteString -> IO ()
writeFile String
configModule (ByteString -> IO ())
-> ([ByteString] -> ByteString) -> [ByteString] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
object ([ByteString] -> IO ()) -> [ByteString] -> IO ()
forall a b. (a -> b) -> a -> b
$ (String, ByteString) -> ByteString
var ((String, ByteString) -> ByteString)
-> [(String, ByteString)] -> [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(String, ByteString)]
jsVars
  where
    configModule :: String
configModule = String
destinationDir String -> String -> String
</> String
"Hablo" String -> String -> String
</> String
"Config.js"

generateMain :: FilePath -> IO ()
generateMain :: String -> IO ()
generateMain String
destinationDir = do
  String
habloSources <- (String -> String -> String
</> String
"js") (String -> String) -> IO String -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO String
getDataDir
  Result
result <- Source -> IO Result
compile (Source -> IO Result) -> Source -> IO Result
forall a b. (a -> b) -> a -> b
$ [String] -> Source
source [String
destinationDir, String
"unitJS", String
habloSources]
  IO () -> (Text -> IO ()) -> Maybe Text -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> IO ()
forall a. String -> IO a
die String
"JS compilation failed\n") Text -> IO ()
output (Maybe Text -> IO ()) -> IO (Maybe Text) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Result -> IO (Maybe Text)
sourceCode Result
result
  where
    output :: Text -> IO ()
output = String -> ByteString -> IO ()
writeFile (String
destinationDir String -> String -> String
</> String
"hablo.js") (ByteString -> IO ()) -> (Text -> ByteString) -> Text -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
fromStrict (ByteString -> ByteString)
-> (Text -> ByteString) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8

generate :: ReaderT Blog IO ()
generate :: ReaderT Blog IO ()
generate = do
  String
destinationDir <- (Blog -> String) -> ReaderT Blog IO String
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((Blog -> String) -> ReaderT Blog IO String)
-> (Blog -> String) -> ReaderT Blog IO String
forall a b. (a -> b) -> a -> b
$Blog -> Path
path(Blog -> Path) -> (Path -> String) -> Blog -> String
forall a b c. (a -> b) -> (b -> c) -> a -> c
.$Path -> String
root(Blog -> String) -> (String -> String) -> Blog -> String
forall a b c. (a -> b) -> (b -> c) -> a -> c
.$(String -> String -> String
</> String
"js")
  IO () -> ReaderT Blog IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ReaderT Blog IO ())
-> (String -> IO ()) -> String -> ReaderT Blog IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> String -> IO ()
createDirectoryIfMissing Bool
True (String -> ReaderT Blog IO ()) -> String -> ReaderT Blog IO ()
forall a b. (a -> b) -> a -> b
$ String
destinationDir String -> String -> String
</> String
"Hablo"
  String -> ReaderT Blog IO ()
generateConfig String
destinationDir
  IO () -> ReaderT Blog IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ReaderT Blog IO ()) -> IO () -> ReaderT Blog IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
generateMain String
destinationDir