65 lines
2.0 KiB
Haskell
65 lines
2.0 KiB
Haskell
{-# LANGUAGE NamedFieldPuns #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
module Module.File (
|
|
File(..)
|
|
, header
|
|
, footer
|
|
, parser
|
|
, variables
|
|
) where
|
|
|
|
import Context (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 Module.Imports (Reference(..), Tree(..))
|
|
import qualified Module.Imports (parser)
|
|
import Prelude hiding (takeWhile)
|
|
import Text.Printf (printf)
|
|
|
|
data File = File {
|
|
isMain :: Bool
|
|
, imports :: Tree
|
|
, payload :: [Text]
|
|
} deriving Show
|
|
|
|
parser :: Bool -> Parser File
|
|
parser isMain = File isMain
|
|
<$> Module.Imports.parser
|
|
<*> (blank *> line `sepBy` eol)
|
|
where
|
|
eol = string "\r\n" <|> string "\r" <|> string "\n"
|
|
blank = takeWhile (inClass " \t\r\n")
|
|
line = takeTill isEndOfLine
|
|
|
|
header :: Bool -> Path -> [String] -> Text
|
|
header isMain path names = Text.pack (outside isMain ++ arguments)
|
|
where
|
|
outside True = ""
|
|
outside False = printf "modules['%s'] = " (show path)
|
|
arguments = printf "(function(%s) {" (intercalate ", " $ names ++ ["modules"])
|
|
|
|
footer :: [String] -> [Text]
|
|
footer values = [Text.pack $ printf "})(%s);" (intercalate ", " values)]
|
|
|
|
variables :: Tree -> [(String, String)]
|
|
variables = fmap (fmap computeValue) . Map.toList . children
|
|
where
|
|
computeValue :: Tree -> String
|
|
computeValue subTree =
|
|
let subModules = intercalate ", " $ f <$> Map.toList (children subTree) in
|
|
case target subTree of
|
|
Nothing -> printf "Object.create(null, {%s})" subModules
|
|
Just (ModulePath {modulePath}) ->
|
|
printf "Object.create(modules['%s'], {%s})"
|
|
(show modulePath)
|
|
subModules
|
|
Just (Object {modulePath, field}) ->
|
|
printf "modules['%s'].%s" (show modulePath) field
|
|
f (name, subTree) = printf "%s: {value: %s}" name $ computeValue subTree
|