{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
module SJW.Module.File (
      File(..)
    , header
    , footer
    , parser
    , variables
  ) where

import SJW.Source (Path)
import Control.Applicative ((<|>))
import Data.Attoparsec.Text (
      Parser, inClass, isEndOfLine, sepBy, string, takeTill, takeWhile
  )
import Data.List (intercalate)
import qualified Data.Map as Map (toList)
import Data.Text (Text)
import qualified Data.Text as Text (pack)
import SJW.Module.Imports (Reference(..), Tree(..))
import qualified SJW.Module.Imports as Imports (parser)
import Prelude hiding (takeWhile)
import Text.Printf (printf)

data File = File {
      File -> Bool
isMain :: Bool
    , File -> Tree
imports :: Tree
    , File -> [Text]
payload :: [Text]
  } deriving Int -> File -> ShowS
[File] -> ShowS
File -> String
(Int -> File -> ShowS)
-> (File -> String) -> ([File] -> ShowS) -> Show File
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [File] -> ShowS
$cshowList :: [File] -> ShowS
show :: File -> String
$cshow :: File -> String
showsPrec :: Int -> File -> ShowS
$cshowsPrec :: Int -> File -> ShowS
Show

parser :: Bool -> Parser File
parser :: Bool -> Parser File
parser Bool
isMain = Bool -> Tree -> [Text] -> File
File Bool
isMain
  (Tree -> [Text] -> File)
-> Parser Text Tree -> Parser Text ([Text] -> File)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Tree
Imports.parser
  Parser Text ([Text] -> File) -> Parser Text [Text] -> Parser File
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser Text
blank Parser Text -> Parser Text [Text] -> Parser Text [Text]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text
line Parser Text -> Parser Text -> Parser Text [Text]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`sepBy` Parser Text
eol)
  where
    eol :: Parser Text
eol = Text -> Parser Text
string Text
"\r\n" Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Parser Text
string Text
"\r" Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Parser Text
string Text
"\n"
    blank :: Parser Text
blank = (Char -> Bool) -> Parser Text
takeWhile (String -> Char -> Bool
inClass String
" \t\r\n")
    line :: Parser Text
line = (Char -> Bool) -> Parser Text
takeTill Char -> Bool
isEndOfLine

header :: Bool -> Path -> [String] -> Text
header :: Bool -> Path -> [String] -> Text
header Bool
isMain Path
path [String]
names = String -> Text
Text.pack (Bool -> String
forall p. (IsString p, PrintfType p) => Bool -> p
outside Bool
isMain String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
arguments)
  where
    outside :: Bool -> p
outside Bool
True = p
""
    outside Bool
False = String -> String -> p
forall r. PrintfType r => String -> r
printf String
"modules['%s'] = " (Path -> String
forall a. Show a => a -> String
show Path
path)
    arguments :: String
arguments = String -> ShowS
forall r. PrintfType r => String -> r
printf String
"(function(%s) {" (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String]
names [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"modules"])

footer :: [String] -> [Text]
footer :: [String] -> [Text]
footer [String]
values = [String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> ShowS
forall r. PrintfType r => String -> r
printf String
"})(%s);" (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " [String]
values)]

variables :: Tree -> [(String, String)]
variables :: Tree -> [(String, String)]
variables = ((String, Tree) -> (String, String))
-> [(String, Tree)] -> [(String, String)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Tree -> String) -> (String, Tree) -> (String, String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Tree -> String
computeValue) ([(String, Tree)] -> [(String, String)])
-> (Tree -> [(String, Tree)]) -> Tree -> [(String, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map String Tree -> [(String, Tree)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map String Tree -> [(String, Tree)])
-> (Tree -> Map String Tree) -> Tree -> [(String, Tree)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree -> Map String Tree
children
  where
    computeValue :: Tree -> String
    computeValue :: Tree -> String
computeValue Tree
subTree =
      let subModules :: String
subModules = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (String, Tree) -> String
forall t t. (PrintfArg t, PrintfType t) => (t, Tree) -> t
f ((String, Tree) -> String) -> [(String, Tree)] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map String Tree -> [(String, Tree)]
forall k a. Map k a -> [(k, a)]
Map.toList (Tree -> Map String Tree
children Tree
subTree) in
      case Tree -> Maybe Reference
target Tree
subTree of
        Maybe Reference
Nothing -> String -> ShowS
forall r. PrintfType r => String -> r
printf String
"Object.create(null, {%s})" String
subModules
        Just (ModulePath {Path
modulePath :: Reference -> Path
modulePath :: Path
modulePath}) ->
          String -> String -> ShowS
forall r. PrintfType r => String -> r
printf String
"Object.create(modules['%s'], {%s})"
            (Path -> String
forall a. Show a => a -> String
show Path
modulePath)
            String
subModules
        Just (Object {Path
modulePath :: Path
modulePath :: Reference -> Path
modulePath, String
field :: Reference -> String
field :: String
field}) ->
          String -> String -> ShowS
forall r. PrintfType r => String -> r
printf String
"modules['%s'].%s" (Path -> String
forall a. Show a => a -> String
show Path
modulePath) String
field
    f :: (t, Tree) -> t
f (t
name, Tree
subTree) = String -> t -> String -> t
forall r. PrintfType r => String -> r
printf String
"%s: {value: %s}" t
name (String -> t) -> String -> t
forall a b. (a -> b) -> a -> b
$ Tree -> String
computeValue Tree
subTree