src/Psb/Main.hs

@@ -21,7 +21,6 @@ import qualified Development.Shake as Shake
 import Development.Shake.FilePath ((</>))
 import qualified Development.Shake.FilePath as FP
 import Templates
-import Text.Megaparsec (errorBundlePretty)
 import Types
 import Utilities.Action (getPublishedPosts, isDraft', markdownToHtml, markdownToPost, now, psbProgress)
 import qualified Utilities.CSS as CSS
@@ -93,15 +92,9 @@ css_resources =
 js_resources :: Rules ()
 js_resources =
   map (outputDir </>) jsGlobs |%> \target -> do
-    let src_file = FP.dropDirectory1 target
+    src <- Shake.readFile' $ FP.dropDirectory1 target
-    src <- Shake.readFile' $ src_file
+    -- TODO: write to fingerprinted location as well
-
+    Shake.writeFileChanged target $ JS.minify src
-    let tokenization = JS.toTokens src_file src
-    case tokenization of
-      Left e -> error $ "Attempt to tokenize javascript file failed with: " <> errorBundlePretty e
-      Right tokens ->
-        -- TODO: write to fingerprinted location as well
-        Shake.writeFileChanged target $ foldMap JS.displayToken $ JS.minify $ tokens
 
 -- there's probably a better way of doing this that allows for the target's origin file extension to get passed in but for now we're doing brute force
 postsRule :: Rules ()

src/Utilities/Javascript.hs

@@ -10,14 +10,12 @@ where
 
 import Control.Applicative (Alternative (many), optional, (<|>))
 import Data.Data (Proxy (Proxy))
-import Data.Functor ((<&>))
 import Data.Maybe (maybeToList)
 import Data.String (IsString (fromString))
 import Data.Void (Void)
 import Logger
 import Text.Megaparsec (MonadParsec (notFollowedBy, try), ParseErrorBundle, Stream (tokensToChunk), anySingle, choice, parse)
-import qualified Text.Megaparsec as MP
+import Text.Megaparsec.Char (hspace, newline, string)
-import Text.Megaparsec.Char (char, digitChar, hspace, letterChar, newline, string)
 import Utilities.Parsing
 
 minify :: (Characters s) => [Token s] -> [Token s]
@@ -32,8 +30,8 @@ minify = reduce_identifiers . remove_redundants
       WhiteSpace -> False
       _ -> True
 
-toTokens :: (Characters s) => String -> s -> Either (ParseErrorBundle s Void) [Token s]
+toTokens :: (Characters s) => s -> Either (ParseErrorBundle s Void) [Token s]
-toTokens = parse tokens
+toTokens = parse tokens ""
 
 displayToken :: (ToText s) => Token s -> s
 displayToken _ = error "TODO"
@@ -52,15 +50,14 @@ data Token s
   | ReservedWord Reserved
   | Literal (Literal s)
   | Punc Punctuator
-  deriving (Eq)
 
-data Reserved = Await | Break | Case | Catch | Class | Const | Continue | Debugger | Default | Delete | Do | Else | Enum | Export | Extends | FalseVal | Finally | For | Function | If | Import | In | Instanceof | New | Null | Return | Super | Switch | This | Throw | TrueVal | Try | Typeof | Var | Void | While | With | Yield deriving (Eq)
+data Reserved = Await | Break | Case | Catch | Class | Const | Continue | Debugger | Default | Delete | Do | Else | Enum | Export | Extends | FalseVal | Finally | For | Function | If | Import | In | Instanceof | New | Null | Return | Super | Switch | This | Throw | TrueVal | Try | Typeof | Var | Void | While | With | Yield
 
-data Literal s = Number s | String s | Regex s | TemplateFragment (TemplateFragment s) deriving (Eq)
+data Literal s = Number s | String s | Regex s | TemplateFragment (TemplateFragment s)
 
-data TemplateFragment s = NoSub s | TemplateHead s | TemplateMiddle s | TemplateTail s deriving (Eq)
+data TemplateFragment s = NoSub s | TemplateHead s | TemplateMiddle s | TemplateTail s
 
-data Punctuator = Add | Sub | Mult | Div | Mod | Exp | Inc | Dec | LT | GT | LTEQ | GTEQ | DoubleEqual | NotEqual | TripleEqual | DoubleNotEqual | LeftShift | RightShift {- >>> -} | UnsignedRightShift | BitwiseAnd | BitwiseOr | BitwiseXor | BitwiseNot | LogicalAnd | LogicalOr | LogicalNot {- ?? -} | Nullish | Assign | AddAssign | SubAssign | MultAssign | DivAssign | ModAssign | ExpAssign | LeftShiftAssign | RightShiftAssign | UnsignedRightShiftAssign | BitwiseAndAssign | BitwiseOrAssign | BitwiseXorAssign | LogicalAndAssign | LogicalOrAssign | NullishAssign | LParen | RParen | LCurly | RCurly | LSquare | RSquare | Dot | Spread | Semicolon | Comma | OptionalChain deriving (Eq)
+data Punctuator = Add | Sub | Mult | Div | Mod | Exp | Inc | Dec | LT | GT | LTEQ | GTEQ | DoubleEqual | NotEqual | TripleEqual | DoubleNotEqual | LeftShift | RightShift {- >>> -} | UnsignedRightShift | BitwiseAnd | BitwiseOr | BitwiseXor | BitwiseNot | LogicalAnd | LogicalOr | LogicalNot {- ?? -} | Nullish | Assign | AddAssign | SubAssign | MultAssign | DivAssign | ModAssign | ExpAssign | LeftShiftAssign | RightShiftAssign | UnsignedRightShiftAssign | BitwiseAndAssign | BitwiseOrAssign | BitwiseXorAssign | LogicalAndAssign | LogicalOrAssign | NullishAssign | LParen | RParen | LCurly | RCurly | LSquare | RSquare | Dot | Spread | Semicolon | Comma | OptionalChain
 
 tokens :: (Logger m, Characters s) => Parser s m [Token s]
 tokens = do
@@ -141,103 +138,26 @@ reserved_word = choice [try await, try break, try case_, try catch_, try class_,
     with = string "with" *> pure (ReservedWord With)
     yield = string "yield" *> pure (ReservedWord Yield)
 
-identifier :: forall s m. (Logger m, Characters s) => Parser s m (Token s)
+identifier :: (Logger m, Characters s) => Parser s m (Token s)
 identifier = do
   first <- start_char
   rem <- many rem_char
-  pure $ Identifier $ fromString (first : rem)
+  let tmp = toString $ tokensToChunk (Proxy :: Proxy s) rem
+  pure $ Identifier $ fromString (first : tmp)
   where
-    start_char :: Parser s m (MP.Token s)
+    start_char :: Parser s m (Token s)
-    start_char = (char '$') <|> char '_' <|> letterChar
+    start_char = error "TODO"
-    rem_char :: Parser s m (MP.Token s)
+    rem_char :: Parser s m (Token s)
-    rem_char = start_char <|> digitChar
+    rem_char = error "TODO"
 
 private_identifier :: (Logger m, Characters s) => Parser s m (Token s)
-private_identifier =
+private_identifier = error "TODO"
-  char '#'
-    *> identifier
-    <&> \(Identifier i) -> PrivateIdentifier i
 
 literal :: (Logger m, Characters s) => Parser s m (Token s)
-literal =
+literal = error "TODO"
-  Literal
-    <$> ( choice
-            [ try template_fragment,
-              try string_lit,
-              num_lit
-            ]
-        )
-  where
-    template_fragment = TemplateFragment <$> error "TODO"
-    string_lit = String <$> error "TODO"
-    num_lit = Number <$> (choice [try decimal_literal, try decimal_bigint, try plain_bigint, try normal_integer, octal_int])
-    decimal_literal = error "TODO"
-    decimal_bigint = error "TODO"
-    plain_bigint = error "TODO"
-    normal_integer = error "TODO"
-    octal_int = error "TODO"
-
-fslash_handler :: (Logger m, Characters s) => Parser s m (Token s)
-fslash_handler = error "TODO: Regex literal, division and division assignment"
 
 punctuator :: (Logger m, Characters s) => Parser s m (Token s)
-punctuator =
+punctuator = error "TODO"
-  Punc
-    <$> ( choice
-            [ try $ string ">>>=" *> pure UnsignedRightShiftAssign,
-              try $ string "..." *> pure Spread,
-              try $ string "===" *> pure TripleEqual,
-              try $ string "!==" *> pure DoubleNotEqual,
-              try $ string "<<=" *> pure LeftShiftAssign,
-              try $ string ">>=" *> pure RightShiftAssign,
-              try $ string ">>>" *> pure UnsignedRightShift,
-              try $ string "**=" *> pure ExpAssign,
-              try $ string "&&=" *> pure LogicalAndAssign,
-              try $ string "||=" *> pure LogicalOrAssign,
-              try $ string "??=" *> pure NullishAssign,
-              try $ string "?." *> (notFollowedBy digitChar) *> pure OptionalChain,
-              try $ string "**" *> pure Exp,
-              try $ string "++" *> pure Inc,
-              try $ string "--" *> pure Dec,
-              try $ string "<=" *> pure LTEQ,
-              try $ string ">=" *> pure GTEQ,
-              try $ string "==" *> pure DoubleEqual,
-              try $ string "!=" *> pure NotEqual,
-              try $ string "<<" *> pure LeftShift,
-              try $ string ">>" *> pure RightShift,
-              try $ string "+=" *> pure AddAssign,
-              try $ string "-=" *> pure SubAssign,
-              try $ string "*=" *> pure MultAssign,
-              try $ string "%=" *> pure ModAssign,
-              try $ string "&=" *> pure BitwiseAndAssign,
-              try $ string "|=" *> pure BitwiseOrAssign,
-              try $ string "^=" *> pure BitwiseXorAssign,
-              try $ string "&&" *> pure LogicalAnd,
-              try $ string "||" *> pure LogicalOr,
-              try $ string "??" *> pure Nullish,
-              char '+' *> pure Add,
-              char '-' *> pure Sub,
-              char '*' *> pure Mult,
-              char '%' *> pure Mod,
-              char '<' *> pure Utilities.Javascript.LT,
-              char '>' *> pure Utilities.Javascript.GT,
-              char '&' *> pure BitwiseAnd,
-              char '|' *> pure BitwiseOr,
-              char '^' *> pure BitwiseXor,
-              char '~' *> pure BitwiseNot,
-              char '=' *> pure Assign,
-              char '(' *> pure LParen,
-              char ')' *> pure RParen,
-              char '{' *> pure LCurly,
-              char '}' *> pure RCurly,
-              char '[' *> pure LSquare,
-              char ']' *> pure RSquare,
-              char '.' *> pure Dot,
-              char ';' *> pure Semicolon,
-              char ',' *> pure Comma,
-              char '!' *> pure LogicalNot
-            ]
-        )
 
 linebreak :: (Logger m, Characters s) => Parser s m (Token s)
 linebreak = newline *> pure WhiteSpace