{-#LANGUAGE FlexibleContexts #-}
{-#LANGUAGE FlexibleInstances #-}
{-#LANGUAGE OverloadedStrings #-}
{-#LANGUAGE TupleSections #-}
{-#LANGUAGE TypeSynonymInstances #-}
{-#LANGUAGE MultiParamTypeClasses #-}
{-#LANGUAGE ScopedTypeVariables #-}
{-#LANGUAGE LambdaCase #-}
{-#LANGUAGE GeneralizedNewtypeDeriving #-}
module Text.Ginger.PHP
where

import Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.Lazy as LText
import Data.Text.Lazy.Builder (Builder, fromText, fromLazyText, fromString, toLazyText)
import Data.Monoid
import Data.List
import Data.Bifunctor
import Data.Bool
import Data.Scientific (floatingOrInteger)

import Text.Ginger.AST
import Text.Ginger.Html

type LText = LText.Text

-- | Concrete PHP syntax (or rather, the subset we use)
data PHP
  = RawSyntax Text -- ^ whatever
  | Bareword Text -- ^ @foobar@
  | Variable Text -- ^ @$foobar@
  | SQString Text -- ^ @'foobar'@
  | Int Int -- ^ @23@
  | Float Double -- ^ @23.42@
  | Operator Text -- ^ @+@
  | Parenthesized PHP -- @(...)@
  | StmtBlock [PHP] -- @{...}@
  | List [PHP] -- @[a,b,c,...]@
  | Dict [(PHP,PHP)] -- @[a=>b,c=>d,...]@
  | Assign PHP PHP -- @a = b@
  | Binop PHP PHP PHP -- @a + b@
  | Call PHP [PHP] -- @foo(a,b,c...)@
  | Lookup PHP PHP -- @foo[bar]@
  | Lambda [Text] [PHP] -- @function (args) { statements }@
  | Ternary PHP PHP PHP -- @((cond) ? (yes) : (no))
  | Statement PHP -- @foobar;@
  | Return PHP -- @return foobar;@

writeBuilder :: PHP -> Builder
writeBuilder (RawSyntax txt) = fromText txt
writeBuilder (Bareword txt) = fromText txt
writeBuilder (Variable varname) = "$" <> fromText varname
writeBuilder (SQString txt) = "'" <> fromText (escapeSQ txt) <> "'"
writeBuilder (Int i) = fromString . show $ i
writeBuilder (Float f) = fromString . show $ f
writeBuilder (Operator txt) = fromText txt
writeBuilder (Parenthesized inner) = "(" <> writeBuilder inner <> ")"
writeBuilder (StmtBlock items) = "{" <> (mconcat . map writeBuilder $ items) <> "}"
writeBuilder (List items) = "[" <> (mconcat . intersperse ", " . map writeBuilder $ items) <> "]"
writeBuilder (Dict pairs) = "[" <> (mconcat . intersperse ", " . map writePair $ pairs) <> "]"
  where
    writePair (a, b) = writeBuilder a <> " => " <> writeBuilder b
writeBuilder (Binop lhs op rhs) = writeBuilder lhs <> " " <> writeBuilder op <> " " <> writeBuilder rhs
writeBuilder (Call fn args) = "(" <> writeBuilder fn <> "(" <> (mconcat . intersperse ", " . map writeBuilder $ args) <> "))"
writeBuilder (Lookup dict key) = writeBuilder dict <> "[" <> writeBuilder key <> "]"
writeBuilder (Lambda args stmts) =
  "(function (" <>
  (mconcat . intersperse ", " . map (("$" <>) . fromText) $ args) <>
  ") {" <>
  (mconcat . intersperse ";" . map writeBuilder $ stmts) <>
  "})"
writeBuilder (Ternary cond yes no) =
  "((" <> writeBuilder cond <> ") ? (" <> writeBuilder yes <> ") : (" <> writeBuilder no <> "))"
writeBuilder (Statement expr) = writeBuilder expr <> ";\n"
writeBuilder (Assign a b) = "$" <> writeBuilder a <> " = " <> writeBuilder b <> ";"
writeBuilder (Return expr) = "return " <> writeBuilder expr <> ";\n"

writeText :: PHP -> LText
writeText = toLazyText . writeBuilder

escapeSQ :: Text -> Text
escapeSQ = Text.concatMap escapeCharSQ

escapeCharSQ :: Char -> Text
escapeCharSQ '\'' = "\\'"
escapeCharSQ c = Text.singleton c

exprToPHP :: Expression a -> PHP
exprToPHP (StringLiteralE pos str) =
  SQString str
exprToPHP (NumberLiteralE pos num) =
  either Float Int $ floatingOrInteger num
exprToPHP (BoolLiteralE pos b) =
  Bareword $ bool "false" "true" b
exprToPHP (NullLiteralE pos) =
  Bareword "null"
exprToPHP (VarE pos name) =
  Variable name
exprToPHP (ListE pos expressions) =
  List $ map exprToPHP expressions
exprToPHP (ObjectE pos pairs) =
  Dict $ map (bimap exprToPHP exprToPHP) pairs
exprToPHP (MemberLookupE pos container key) =
  Lookup (exprToPHP container) (exprToPHP key)
exprToPHP (CallE pos callee arglist) =
  Call (exprToPHP callee) (map (exprToPHP . snd) arglist)
exprToPHP (LambdaE pos argspec body) =
  Lambda argspec [Return $ exprToPHP body]
exprToPHP (TernaryE pos cond yes no) =
  Ternary (exprToPHP cond) (exprToPHP yes) (exprToPHP no)
exprToPHP (DoE pos stmt) =
  undefined