module Hydra.Util.Codetree.Script where

import Hydra.Util.Codetree.Ast

import qualified Data.List as L


angleBraces :: Brackets
angleBraces :: Brackets
angleBraces = Symbol -> Symbol -> Brackets
Brackets (String -> Symbol
sym String
"<") (String -> Symbol
sym String
">")

angleBracesList ::  BlockStyle -> [Expr] -> Expr
angleBracesList :: BlockStyle -> [Expr] -> Expr
angleBracesList BlockStyle
style [Expr]
els = case [Expr]
els of
  [] -> String -> Expr
cst String
"<>"
  [Expr]
_ -> Brackets -> BlockStyle -> Expr -> Expr
brackets Brackets
angleBraces BlockStyle
style forall a b. (a -> b) -> a -> b
$ BlockStyle -> [Expr] -> Expr
commaSep BlockStyle
style [Expr]
els

bracketList :: BlockStyle -> [Expr] -> Expr
bracketList :: BlockStyle -> [Expr] -> Expr
bracketList BlockStyle
style [Expr]
els = case [Expr]
els of
  [] -> String -> Expr
cst String
"[]"
  [Expr]
_ -> Brackets -> BlockStyle -> Expr -> Expr
brackets Brackets
squareBrackets BlockStyle
style forall a b. (a -> b) -> a -> b
$ BlockStyle -> [Expr] -> Expr
commaSep BlockStyle
style [Expr]
els

brackets :: Brackets -> BlockStyle -> Expr -> Expr
brackets :: Brackets -> BlockStyle -> Expr -> Expr
brackets Brackets
br BlockStyle
style Expr
e = BracketExpr -> Expr
ExprBrackets forall a b. (a -> b) -> a -> b
$ Brackets -> Expr -> BlockStyle -> BracketExpr
BracketExpr Brackets
br Expr
e BlockStyle
style

commaSep :: BlockStyle -> [Expr] -> Expr
commaSep :: BlockStyle -> [Expr] -> Expr
commaSep BlockStyle
style [Expr]
l = case [Expr]
l of
    [] -> String -> Expr
cst String
""
    [Expr
x] -> Expr
x
    (Expr
h:[Expr]
r) -> Op -> Expr -> Expr -> Expr
ifx Op
commaOp Expr
h forall a b. (a -> b) -> a -> b
$ BlockStyle -> [Expr] -> Expr
commaSep BlockStyle
style [Expr]
r
  where
    break :: Ws
break = case forall (t :: * -> *) a. Foldable t => t a -> Int
L.length forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
L.filter forall a. a -> a
id [BlockStyle -> Bool
blockStyleNewlineBeforeContent BlockStyle
style, BlockStyle -> Bool
blockStyleNewlineAfterContent BlockStyle
style] of
      Int
0 -> Ws
WsSpace
      Int
1 -> Ws
WsBreak
      Int
2 -> Ws
WsDoubleBreak
    commaOp :: Op
commaOp = Symbol -> Padding -> Precedence -> Associativity -> Op
Op (String -> Symbol
sym String
",") (Ws -> Ws -> Padding
Padding Ws
WsNone Ws
break) (Int -> Precedence
Precedence Int
0) Associativity
AssociativityNone -- No source

curlyBlock :: BlockStyle -> Expr -> Expr
curlyBlock :: BlockStyle -> Expr -> Expr
curlyBlock BlockStyle
style Expr
e = BlockStyle -> [Expr] -> Expr
curlyBracesList BlockStyle
style [Expr
e]

curlyBraces :: Brackets
curlyBraces :: Brackets
curlyBraces = Symbol -> Symbol -> Brackets
Brackets (String -> Symbol
sym String
"{") (String -> Symbol
sym String
"}")

curlyBracesList :: BlockStyle -> [Expr] -> Expr
curlyBracesList :: BlockStyle -> [Expr] -> Expr
curlyBracesList BlockStyle
style [Expr]
els = case [Expr]
els of
  [] -> String -> Expr
cst String
"{}"
  [Expr]
_ -> Brackets -> BlockStyle -> Expr -> Expr
brackets Brackets
curlyBraces BlockStyle
style forall a b. (a -> b) -> a -> b
$ BlockStyle -> [Expr] -> Expr
commaSep BlockStyle
style [Expr]
els

cst :: String -> Expr
cst :: String -> Expr
cst = Symbol -> Expr
ExprConst forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Symbol
Symbol

dotSep :: [Expr] -> Expr
dotSep :: [Expr] -> Expr
dotSep = Op -> [Expr] -> Expr
sep forall a b. (a -> b) -> a -> b
$ Symbol -> Padding -> Precedence -> Associativity -> Op
Op (String -> Symbol
sym String
".") (Ws -> Ws -> Padding
Padding Ws
WsNone Ws
WsNone) (Int -> Precedence
Precedence Int
0) Associativity
AssociativityNone

doubleNewlineSep :: [Expr] -> Expr
doubleNewlineSep :: [Expr] -> Expr
doubleNewlineSep = Op -> [Expr] -> Expr
sep forall a b. (a -> b) -> a -> b
$ Symbol -> Padding -> Precedence -> Associativity -> Op
Op (String -> Symbol
sym String
"") (Ws -> Ws -> Padding
Padding Ws
WsBreak Ws
WsBreak) (Int -> Precedence
Precedence Int
0) Associativity
AssociativityNone

fullBlockStyle :: BlockStyle
fullBlockStyle :: BlockStyle
fullBlockStyle = Bool -> Bool -> Bool -> BlockStyle
BlockStyle Bool
True Bool
True Bool
True

halfBlockStyle :: BlockStyle
halfBlockStyle :: BlockStyle
halfBlockStyle = Bool -> Bool -> Bool -> BlockStyle
BlockStyle Bool
True Bool
True Bool
False

ifx :: Op -> Expr -> Expr -> Expr
ifx :: Op -> Expr -> Expr -> Expr
ifx Op
op Expr
lhs Expr
rhs = OpExpr -> Expr
ExprOp forall a b. (a -> b) -> a -> b
$ Op -> Expr -> Expr -> OpExpr
OpExpr Op
op Expr
lhs Expr
rhs

indent :: String -> String
indent :: String -> String
indent String
s = forall a. [a] -> [[a]] -> [a]
L.intercalate String
"\n" forall a b. (a -> b) -> a -> b
$ (String
"  " forall a. [a] -> [a] -> [a]
++) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> [String]
lines String
s

indentBlock :: Expr -> [Expr] -> Expr
indentBlock :: Expr -> [Expr] -> Expr
indentBlock Expr
head [Expr]
els = Op -> Expr -> Expr -> Expr
ifx Op
idtOp Expr
head forall a b. (a -> b) -> a -> b
$ [Expr] -> Expr
newlineSep [Expr]
els
  where
    idtOp :: Op
idtOp = Symbol -> Padding -> Precedence -> Associativity -> Op
Op (String -> Symbol
sym String
"") (Ws -> Ws -> Padding
Padding Ws
WsSpace Ws
WsBreakAndIndent) (Int -> Precedence
Precedence Int
0) Associativity
AssociativityNone

indentLines :: [Expr] -> Expr
indentLines :: [Expr] -> Expr
indentLines [Expr]
els = Op -> Expr -> Expr -> Expr
ifx Op
topOp (String -> Expr
cst String
"") ([Expr] -> Expr
newlineSep [Expr]
els)
  where
    topOp :: Op
topOp = Symbol -> Padding -> Precedence -> Associativity -> Op
Op (String -> Symbol
sym String
"") (Ws -> Ws -> Padding
Padding Ws
WsNone Ws
WsBreakAndIndent) (Int -> Precedence
Precedence Int
0) Associativity
AssociativityNone

infixWs :: String -> Expr -> Expr -> Expr
infixWs :: String -> Expr -> Expr -> Expr
infixWs String
op Expr
l Expr
r = [Expr] -> Expr
spaceSep [Expr
l, String -> Expr
cst String
op, Expr
r]

infixWsList :: String -> [Expr] -> Expr
infixWsList :: String -> [Expr] -> Expr
infixWsList String
op [Expr]
opers = [Expr] -> Expr
spaceSep forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.foldl (\[Expr]
e Expr
r -> if forall (t :: * -> *) a. Foldable t => t a -> Bool
L.null [Expr]
e then [Expr
r] else Expr
rforall a. a -> [a] -> [a]
:Expr
opExprforall a. a -> [a] -> [a]
:[Expr]
e) [] forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
L.reverse [Expr]
opers
  where
    opExpr :: Expr
opExpr = String -> Expr
cst String
op

inlineStyle :: BlockStyle
inlineStyle :: BlockStyle
inlineStyle = Bool -> Bool -> Bool -> BlockStyle
BlockStyle Bool
False Bool
False Bool
False

newlineSep :: [Expr] -> Expr
newlineSep :: [Expr] -> Expr
newlineSep = Op -> [Expr] -> Expr
sep forall a b. (a -> b) -> a -> b
$ Symbol -> Padding -> Precedence -> Associativity -> Op
Op (String -> Symbol
sym String
"") (Ws -> Ws -> Padding
Padding Ws
WsNone Ws
WsBreak) (Int -> Precedence
Precedence Int
0) Associativity
AssociativityNone

noPadding :: Padding
noPadding :: Padding
noPadding = Ws -> Ws -> Padding
Padding Ws
WsNone Ws
WsNone

noSep :: [Expr] -> Expr
noSep :: [Expr] -> Expr
noSep = Op -> [Expr] -> Expr
sep forall a b. (a -> b) -> a -> b
$ Symbol -> Padding -> Precedence -> Associativity -> Op
Op (String -> Symbol
sym String
"") (Ws -> Ws -> Padding
Padding Ws
WsNone Ws
WsNone) (Int -> Precedence
Precedence Int
0) Associativity
AssociativityNone

num :: Int -> Expr
num :: Int -> Expr
num = String -> Expr
cst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show

op :: String -> Int -> Associativity -> Op
op :: String -> Int -> Associativity -> Op
op String
s Int
p = Symbol -> Padding -> Precedence -> Associativity -> Op
Op (String -> Symbol
Symbol String
s) (Ws -> Ws -> Padding
Padding Ws
WsSpace Ws
WsSpace) (Int -> Precedence
Precedence Int
p)

orOp :: Bool -> Op
orOp :: Bool -> Op
orOp Bool
newlines = Symbol -> Padding -> Precedence -> Associativity -> Op
Op (String -> Symbol
sym String
"|") (Ws -> Ws -> Padding
Padding Ws
WsSpace (if Bool
newlines then Ws
WsBreak else Ws
WsSpace)) (Int -> Precedence
Precedence Int
0) Associativity
AssociativityNone -- No source

orSep :: BlockStyle -> [Expr] -> Expr
orSep :: BlockStyle -> [Expr] -> Expr
orSep BlockStyle
style [Expr]
l = case [Expr]
l of
  [] -> String -> Expr
cst String
""
  [Expr
x] -> Expr
x
  (Expr
h:[Expr]
r) -> Op -> Expr -> Expr -> Expr
ifx (Bool -> Op
orOp Bool
newlines) Expr
h forall a b. (a -> b) -> a -> b
$ BlockStyle -> [Expr] -> Expr
orSep BlockStyle
style [Expr]
r
  where
    newlines :: Bool
newlines = BlockStyle -> Bool
blockStyleNewlineBeforeContent BlockStyle
style

parenList :: Bool -> [Expr] -> Expr
parenList :: Bool -> [Expr] -> Expr
parenList Bool
newlines [Expr]
els = case [Expr]
els of
    [] -> String -> Expr
cst String
"()"
    [Expr]
_ -> Brackets -> BlockStyle -> Expr -> Expr
brackets Brackets
parentheses BlockStyle
style forall a b. (a -> b) -> a -> b
$ BlockStyle -> [Expr] -> Expr
commaSep BlockStyle
style [Expr]
els
  where
    style :: BlockStyle
style = if Bool
newlines Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Int
L.length [Expr]
els forall a. Ord a => a -> a -> Bool
> Int
1 then BlockStyle
halfBlockStyle else BlockStyle
inlineStyle

parens :: Expr -> Expr
parens :: Expr -> Expr
parens = Brackets -> BlockStyle -> Expr -> Expr
brackets Brackets
parentheses BlockStyle
inlineStyle

parentheses :: Brackets
parentheses :: Brackets
parentheses = Symbol -> Symbol -> Brackets
Brackets (String -> Symbol
sym String
"(") (String -> Symbol
sym String
")")

parenthesize :: Expr -> Expr
parenthesize :: Expr -> Expr
parenthesize Expr
exp = case Expr
exp of
  ExprOp (OpExpr op :: Op
op@(Op Symbol
_ Padding
_ Precedence
prec Associativity
assoc) Expr
lhs Expr
rhs) -> OpExpr -> Expr
ExprOp (Op -> Expr -> Expr -> OpExpr
OpExpr Op
op Expr
lhs2 Expr
rhs2)
    where
      lhs' :: Expr
lhs' = Expr -> Expr
parenthesize Expr
lhs
      rhs' :: Expr
rhs' = Expr -> Expr
parenthesize Expr
rhs
      lhs2 :: Expr
lhs2 = case Expr
lhs' of
        ExprOp (OpExpr (Op Symbol
_ Padding
_ Precedence
lprec Associativity
lassoc) Expr
_ Expr
_) -> case Precedence
prec forall a. Ord a => a -> a -> Ordering
`compare` Precedence
lprec of
          Ordering
LT -> Expr
lhs'
          Ordering
GT -> Expr -> Expr
parens Expr
lhs'
          Ordering
EQ -> if Associativity -> Bool
assocLeft Associativity
assoc Bool -> Bool -> Bool
&& Associativity -> Bool
assocLeft Associativity
lassoc
            then Expr
lhs'
            else Expr -> Expr
parens Expr
lhs'
        Expr
_ -> Expr
lhs'
      rhs2 :: Expr
rhs2 = case Expr
rhs' of
        ExprOp (OpExpr (Op Symbol
_ Padding
_ Precedence
rprec Associativity
rassoc) Expr
_ Expr
_) -> case Precedence
prec forall a. Ord a => a -> a -> Ordering
`compare` Precedence
rprec of
          Ordering
LT -> Expr
rhs'
          Ordering
GT -> Expr -> Expr
parens Expr
rhs'
          Ordering
EQ -> if Associativity -> Bool
assocRight Associativity
assoc Bool -> Bool -> Bool
&& Associativity -> Bool
assocRight Associativity
rassoc
            then Expr
rhs'
            else Expr -> Expr
parens Expr
rhs'
        Expr
_ -> Expr
rhs'
      assocLeft :: Associativity -> Bool
assocLeft Associativity
a = Associativity
a forall a. Eq a => a -> a -> Bool
== Associativity
AssociativityLeft Bool -> Bool -> Bool
|| Associativity
a forall a. Eq a => a -> a -> Bool
== Associativity
AssociativityNone Bool -> Bool -> Bool
|| Associativity
a forall a. Eq a => a -> a -> Bool
== Associativity
AssociativityBoth
      assocRight :: Associativity -> Bool
assocRight Associativity
a = Associativity
a forall a. Eq a => a -> a -> Bool
== Associativity
AssociativityRight Bool -> Bool -> Bool
|| Associativity
a forall a. Eq a => a -> a -> Bool
== Associativity
AssociativityNone Bool -> Bool -> Bool
|| Associativity
a forall a. Eq a => a -> a -> Bool
== Associativity
AssociativityBoth
  ExprBrackets (BracketExpr Brackets
br Expr
e BlockStyle
newlines) -> BracketExpr -> Expr
ExprBrackets (Brackets -> Expr -> BlockStyle -> BracketExpr
BracketExpr Brackets
br (Expr -> Expr
parenthesize Expr
e) BlockStyle
newlines)
  Expr
_ -> Expr
exp

prefix :: String -> Expr -> Expr
prefix :: String -> Expr -> Expr
prefix String
p = Op -> Expr -> Expr -> Expr
ifx Op
preOp (String -> Expr
cst String
"")
  where
    preOp :: Op
preOp = Symbol -> Padding -> Precedence -> Associativity -> Op
Op (String -> Symbol
sym String
p) (Ws -> Ws -> Padding
Padding Ws
WsNone Ws
WsNone) (Int -> Precedence
Precedence Int
0) Associativity
AssociativityNone

printExpr :: Expr -> String
printExpr :: Expr -> String
printExpr Expr
e = case Expr
e of
  ExprConst (Symbol String
s) -> String
s
  ExprOp (OpExpr (Op (Symbol String
sym) (Padding Ws
padl Ws
padr) Precedence
_ Associativity
_) Expr
l Expr
r) -> String
lhs forall a. [a] -> [a] -> [a]
++ Ws -> String
pad Ws
padl forall a. [a] -> [a] -> [a]
++ String
sym forall a. [a] -> [a] -> [a]
++ Ws -> String
pad Ws
padr forall a. [a] -> [a] -> [a]
++ String
rhs
    where
      lhs :: String
lhs = Ws -> String -> String
idt Ws
padl forall a b. (a -> b) -> a -> b
$ Expr -> String
printExpr Expr
l
      rhs :: String
rhs = Ws -> String -> String
idt Ws
padr forall a b. (a -> b) -> a -> b
$ Expr -> String
printExpr Expr
r
      idt :: Ws -> String -> String
idt Ws
ws String
s = if Ws
ws forall a. Eq a => a -> a -> Bool
== Ws
WsBreakAndIndent then String -> String
indent String
s else String
s
      pad :: Ws -> String
pad Ws
ws = case Ws
ws of
        Ws
WsNone -> String
""
        Ws
WsSpace -> String
" "
        Ws
WsBreak -> String
"\n"
        Ws
WsBreakAndIndent -> String
"\n"
        Ws
WsDoubleBreak -> String
"\n\n"
  ExprBrackets (BracketExpr (Brackets (Symbol String
l) (Symbol String
r)) Expr
e BlockStyle
style) ->
      String
l forall a. [a] -> [a] -> [a]
++ String
pre forall a. [a] -> [a] -> [a]
++ String
ibody forall a. [a] -> [a] -> [a]
++ String
suf forall a. [a] -> [a] -> [a]
++ String
r
    where
      body :: String
body = Expr -> String
printExpr Expr
e
      ibody :: String
ibody = if Bool
doIndent then String -> String
indent String
body else String
body
      pre :: String
pre = if Bool
nlBefore then String
"\n" else String
""
      suf :: String
suf = if Bool
nlAfter then String
"\n" else String
""
      BlockStyle Bool
doIndent Bool
nlBefore Bool
nlAfter = BlockStyle
style

printExprAsTree :: Expr -> String
printExprAsTree :: Expr -> String
printExprAsTree Expr
expr = case Expr
expr of
  ExprConst (Symbol String
s) -> String
s
  ExprBrackets (BracketExpr (Brackets (Symbol String
l) (Symbol String
r)) Expr
e BlockStyle
_) -> String
l forall a. [a] -> [a] -> [a]
++ String
r forall a. [a] -> [a] -> [a]
++ String
":\n" forall a. [a] -> [a] -> [a]
++ String -> String
indent (Expr -> String
printExprAsTree Expr
e)
  ExprOp (OpExpr Op
op Expr
l Expr
r) -> Symbol -> String
h (Op -> Symbol
opSymbol Op
op) forall a. [a] -> [a] -> [a]
++ String
":\n" forall a. [a] -> [a] -> [a]
++ String -> String
indent (Expr -> String
printExprAsTree Expr
l) forall a. [a] -> [a] -> [a]
++ String
"\n" forall a. [a] -> [a] -> [a]
++ String -> String
indent (Expr -> String
printExprAsTree Expr
r)
    where
      h :: Symbol -> String
h (Symbol String
s) = String
s

sep :: Op -> [Expr] -> Expr
sep :: Op -> [Expr] -> Expr
sep Op
op [Expr]
els =  case [Expr]
els of
  [] -> String -> Expr
cst String
""
  [Expr
x] -> Expr
x
  (Expr
h:[Expr]
r) -> Op -> Expr -> Expr -> Expr
ifx Op
op Expr
h forall a b. (a -> b) -> a -> b
$ Op -> [Expr] -> Expr
sep Op
op [Expr]
r

spaceSep :: [Expr] -> Expr
spaceSep :: [Expr] -> Expr
spaceSep = Op -> [Expr] -> Expr
sep forall a b. (a -> b) -> a -> b
$ Symbol -> Padding -> Precedence -> Associativity -> Op
Op (String -> Symbol
sym String
"") (Ws -> Ws -> Padding
Padding Ws
WsSpace Ws
WsNone) (Int -> Precedence
Precedence Int
0) Associativity
AssociativityNone

squareBrackets :: Brackets
squareBrackets :: Brackets
squareBrackets = Symbol -> Symbol -> Brackets
Brackets (String -> Symbol
sym String
"[") (String -> Symbol
sym String
"]")

sym :: String -> Symbol
sym :: String -> Symbol
sym = String -> Symbol
Symbol