{-# 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