{- © 2019 Serokell <hi@serokell.io>
 - © 2019 Lars Jellema <lars.jellema@gmail.com>
 -
 - SPDX-License-Identifier: MPL-2.0
 -}

{-# LANGUAGE OverloadedStrings #-}

module Nixfmt.Types where

import Prelude hiding (String)

import Data.Text (Text, pack)
import Data.Void (Void)
import qualified Text.Megaparsec as MP (ParseErrorBundle, Parsec)

-- | A @megaparsec@ @ParsecT@ specified for use with @nixfmt@.
type Parser = MP.Parsec Void Text

-- | A @megaparsec@ @ParseErrorBundle@ specified for use with @nixfmt@.
type ParseErrorBundle = MP.ParseErrorBundle Text Void

data Trivium
    = EmptyLine
    | LineComment     Text
    | BlockComment    [Text]
    deriving (Trivium -> Trivium -> Bool
(Trivium -> Trivium -> Bool)
-> (Trivium -> Trivium -> Bool) -> Eq Trivium
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Trivium -> Trivium -> Bool
$c/= :: Trivium -> Trivium -> Bool
== :: Trivium -> Trivium -> Bool
$c== :: Trivium -> Trivium -> Bool
Eq, Int -> Trivium -> ShowS
[Trivium] -> ShowS
Trivium -> String
(Int -> Trivium -> ShowS)
-> (Trivium -> String) -> ([Trivium] -> ShowS) -> Show Trivium
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Trivium] -> ShowS
$cshowList :: [Trivium] -> ShowS
show :: Trivium -> String
$cshow :: Trivium -> String
showsPrec :: Int -> Trivium -> ShowS
$cshowsPrec :: Int -> Trivium -> ShowS
Show)

type Trivia = [Trivium]

newtype TrailingComment = TrailingComment Text deriving (TrailingComment -> TrailingComment -> Bool
(TrailingComment -> TrailingComment -> Bool)
-> (TrailingComment -> TrailingComment -> Bool)
-> Eq TrailingComment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TrailingComment -> TrailingComment -> Bool
$c/= :: TrailingComment -> TrailingComment -> Bool
== :: TrailingComment -> TrailingComment -> Bool
$c== :: TrailingComment -> TrailingComment -> Bool
Eq, Int -> TrailingComment -> ShowS
[TrailingComment] -> ShowS
TrailingComment -> String
(Int -> TrailingComment -> ShowS)
-> (TrailingComment -> String)
-> ([TrailingComment] -> ShowS)
-> Show TrailingComment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TrailingComment] -> ShowS
$cshowList :: [TrailingComment] -> ShowS
show :: TrailingComment -> String
$cshow :: TrailingComment -> String
showsPrec :: Int -> TrailingComment -> ShowS
$cshowsPrec :: Int -> TrailingComment -> ShowS
Show)

data Ann a
    = Ann a (Maybe TrailingComment) Trivia
    deriving (Int -> Ann a -> ShowS
[Ann a] -> ShowS
Ann a -> String
(Int -> Ann a -> ShowS)
-> (Ann a -> String) -> ([Ann a] -> ShowS) -> Show (Ann a)
forall a. Show a => Int -> Ann a -> ShowS
forall a. Show a => [Ann a] -> ShowS
forall a. Show a => Ann a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Ann a] -> ShowS
$cshowList :: forall a. Show a => [Ann a] -> ShowS
show :: Ann a -> String
$cshow :: forall a. Show a => Ann a -> String
showsPrec :: Int -> Ann a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Ann a -> ShowS
Show)

-- | Equality of annotated syntax is defines as equality of their corresponding
-- semantics, thus ignoring the annotations.
instance Eq a => Eq (Ann a) where
    Ann a
x Maybe TrailingComment
_ [Trivium]
_ == :: Ann a -> Ann a -> Bool
== Ann a
y Maybe TrailingComment
_ [Trivium]
_ = a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y

type Leaf = Ann Token

data StringPart
    = TextPart Text
    | Interpolation Leaf Expression Token
    deriving (StringPart -> StringPart -> Bool
(StringPart -> StringPart -> Bool)
-> (StringPart -> StringPart -> Bool) -> Eq StringPart
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StringPart -> StringPart -> Bool
$c/= :: StringPart -> StringPart -> Bool
== :: StringPart -> StringPart -> Bool
$c== :: StringPart -> StringPart -> Bool
Eq, Int -> StringPart -> ShowS
[StringPart] -> ShowS
StringPart -> String
(Int -> StringPart -> ShowS)
-> (StringPart -> String)
-> ([StringPart] -> ShowS)
-> Show StringPart
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StringPart] -> ShowS
$cshowList :: [StringPart] -> ShowS
show :: StringPart -> String
$cshow :: StringPart -> String
showsPrec :: Int -> StringPart -> ShowS
$cshowsPrec :: Int -> StringPart -> ShowS
Show)

type Path = Ann [StringPart]

type String = Ann [[StringPart]]

data SimpleSelector
    = IDSelector Leaf
    | InterpolSelector (Ann StringPart)
    | StringSelector String
    deriving (SimpleSelector -> SimpleSelector -> Bool
(SimpleSelector -> SimpleSelector -> Bool)
-> (SimpleSelector -> SimpleSelector -> Bool) -> Eq SimpleSelector
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SimpleSelector -> SimpleSelector -> Bool
$c/= :: SimpleSelector -> SimpleSelector -> Bool
== :: SimpleSelector -> SimpleSelector -> Bool
$c== :: SimpleSelector -> SimpleSelector -> Bool
Eq, Int -> SimpleSelector -> ShowS
[SimpleSelector] -> ShowS
SimpleSelector -> String
(Int -> SimpleSelector -> ShowS)
-> (SimpleSelector -> String)
-> ([SimpleSelector] -> ShowS)
-> Show SimpleSelector
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SimpleSelector] -> ShowS
$cshowList :: [SimpleSelector] -> ShowS
show :: SimpleSelector -> String
$cshow :: SimpleSelector -> String
showsPrec :: Int -> SimpleSelector -> ShowS
$cshowsPrec :: Int -> SimpleSelector -> ShowS
Show)

data Selector
    = Selector (Maybe Leaf) SimpleSelector (Maybe (Leaf, Term))
    deriving (Selector -> Selector -> Bool
(Selector -> Selector -> Bool)
-> (Selector -> Selector -> Bool) -> Eq Selector
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Selector -> Selector -> Bool
$c/= :: Selector -> Selector -> Bool
== :: Selector -> Selector -> Bool
$c== :: Selector -> Selector -> Bool
Eq, Int -> Selector -> ShowS
[Selector] -> ShowS
Selector -> String
(Int -> Selector -> ShowS)
-> (Selector -> String) -> ([Selector] -> ShowS) -> Show Selector
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Selector] -> ShowS
$cshowList :: [Selector] -> ShowS
show :: Selector -> String
$cshow :: Selector -> String
showsPrec :: Int -> Selector -> ShowS
$cshowsPrec :: Int -> Selector -> ShowS
Show)

data Binder
    = Inherit Leaf (Maybe Term) [Leaf] Leaf
    | Assignment [Selector] Leaf Expression Leaf
    deriving (Binder -> Binder -> Bool
(Binder -> Binder -> Bool)
-> (Binder -> Binder -> Bool) -> Eq Binder
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Binder -> Binder -> Bool
$c/= :: Binder -> Binder -> Bool
== :: Binder -> Binder -> Bool
$c== :: Binder -> Binder -> Bool
Eq, Int -> Binder -> ShowS
[Binder] -> ShowS
Binder -> String
(Int -> Binder -> ShowS)
-> (Binder -> String) -> ([Binder] -> ShowS) -> Show Binder
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Binder] -> ShowS
$cshowList :: [Binder] -> ShowS
show :: Binder -> String
$cshow :: Binder -> String
showsPrec :: Int -> Binder -> ShowS
$cshowsPrec :: Int -> Binder -> ShowS
Show)

data Term
    = Token Leaf
    | String String
    | Path Path
    | List Leaf [Term] Leaf
    | Set (Maybe Leaf) Leaf [Binder] Leaf
    | Selection Term [Selector]
    | Parenthesized Leaf Expression Leaf
    deriving (Term -> Term -> Bool
(Term -> Term -> Bool) -> (Term -> Term -> Bool) -> Eq Term
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Term -> Term -> Bool
$c/= :: Term -> Term -> Bool
== :: Term -> Term -> Bool
$c== :: Term -> Term -> Bool
Eq, Int -> Term -> ShowS
[Term] -> ShowS
Term -> String
(Int -> Term -> ShowS)
-> (Term -> String) -> ([Term] -> ShowS) -> Show Term
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Term] -> ShowS
$cshowList :: [Term] -> ShowS
show :: Term -> String
$cshow :: Term -> String
showsPrec :: Int -> Term -> ShowS
$cshowsPrec :: Int -> Term -> ShowS
Show)

data ParamAttr
    = ParamAttr Leaf (Maybe (Leaf, Expression)) (Maybe Leaf)
    | ParamEllipsis Leaf
    deriving (ParamAttr -> ParamAttr -> Bool
(ParamAttr -> ParamAttr -> Bool)
-> (ParamAttr -> ParamAttr -> Bool) -> Eq ParamAttr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParamAttr -> ParamAttr -> Bool
$c/= :: ParamAttr -> ParamAttr -> Bool
== :: ParamAttr -> ParamAttr -> Bool
$c== :: ParamAttr -> ParamAttr -> Bool
Eq, Int -> ParamAttr -> ShowS
[ParamAttr] -> ShowS
ParamAttr -> String
(Int -> ParamAttr -> ShowS)
-> (ParamAttr -> String)
-> ([ParamAttr] -> ShowS)
-> Show ParamAttr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParamAttr] -> ShowS
$cshowList :: [ParamAttr] -> ShowS
show :: ParamAttr -> String
$cshow :: ParamAttr -> String
showsPrec :: Int -> ParamAttr -> ShowS
$cshowsPrec :: Int -> ParamAttr -> ShowS
Show)

data Parameter
    = IDParameter Leaf
    | SetParameter Leaf [ParamAttr] Leaf
    | ContextParameter Parameter Leaf Parameter
    deriving (Parameter -> Parameter -> Bool
(Parameter -> Parameter -> Bool)
-> (Parameter -> Parameter -> Bool) -> Eq Parameter
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Parameter -> Parameter -> Bool
$c/= :: Parameter -> Parameter -> Bool
== :: Parameter -> Parameter -> Bool
$c== :: Parameter -> Parameter -> Bool
Eq, Int -> Parameter -> ShowS
[Parameter] -> ShowS
Parameter -> String
(Int -> Parameter -> ShowS)
-> (Parameter -> String)
-> ([Parameter] -> ShowS)
-> Show Parameter
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Parameter] -> ShowS
$cshowList :: [Parameter] -> ShowS
show :: Parameter -> String
$cshow :: Parameter -> String
showsPrec :: Int -> Parameter -> ShowS
$cshowsPrec :: Int -> Parameter -> ShowS
Show)

data Expression
    = Term Term
    | With Leaf Expression Leaf Expression
    | Let Leaf [Binder] Leaf Expression
    | Assert Leaf Expression Leaf Expression
    | If Leaf Expression Leaf Expression Leaf Expression
    | Abstraction Parameter Leaf Expression

    | Application Expression Expression
    | Operation Expression Leaf Expression
    | MemberCheck Expression Leaf [Selector]
    | Negation Leaf Expression
    | Inversion Leaf Expression
    deriving (Expression -> Expression -> Bool
(Expression -> Expression -> Bool)
-> (Expression -> Expression -> Bool) -> Eq Expression
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Expression -> Expression -> Bool
$c/= :: Expression -> Expression -> Bool
== :: Expression -> Expression -> Bool
$c== :: Expression -> Expression -> Bool
Eq, Int -> Expression -> ShowS
[Expression] -> ShowS
Expression -> String
(Int -> Expression -> ShowS)
-> (Expression -> String)
-> ([Expression] -> ShowS)
-> Show Expression
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Expression] -> ShowS
$cshowList :: [Expression] -> ShowS
show :: Expression -> String
$cshow :: Expression -> String
showsPrec :: Int -> Expression -> ShowS
$cshowsPrec :: Int -> Expression -> ShowS
Show)

data File
    = File Leaf Expression
    deriving (File -> File -> Bool
(File -> File -> Bool) -> (File -> File -> Bool) -> Eq File
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: File -> File -> Bool
$c/= :: File -> File -> Bool
== :: File -> File -> Bool
$c== :: File -> File -> Bool
Eq, Int -> File -> ShowS
[File] -> ShowS
File -> String
(Int -> File -> ShowS)
-> (File -> String) -> ([File] -> ShowS) -> Show File
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [File] -> ShowS
$cshowList :: [File] -> ShowS
show :: File -> String
$cshow :: File -> String
showsPrec :: Int -> File -> ShowS
$cshowsPrec :: Int -> File -> ShowS
Show)

data Token
    = Integer    Int
    | Float      Double
    | Identifier Text
    | EnvPath    Text

    | KAssert
    | KElse
    | KIf
    | KIn
    | KInherit
    | KLet
    | KOr
    | KRec
    | KThen
    | KWith

    | TBraceOpen
    | TBraceClose
    | TBrackOpen
    | TBrackClose
    | TInterOpen
    | TInterClose
    | TParenOpen
    | TParenClose

    | TAssign
    | TAt
    | TColon
    | TComma
    | TDot
    | TDoubleQuote
    | TDoubleSingleQuote
    | TEllipsis
    | TQuestion
    | TSemicolon

    | TConcat
    | TNegate
    | TUpdate

    | TPlus
    | TMinus
    | TMul
    | TDiv

    | TAnd
    | TOr
    | TEqual
    | TGreater
    | TGreaterEqual
    | TImplies
    | TLess
    | TLessEqual
    | TNot
    | TUnequal

    | SOF
    deriving (Token -> Token -> Bool
(Token -> Token -> Bool) -> (Token -> Token -> Bool) -> Eq Token
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Token -> Token -> Bool
$c/= :: Token -> Token -> Bool
== :: Token -> Token -> Bool
$c== :: Token -> Token -> Bool
Eq, Int -> Token -> ShowS
[Token] -> ShowS
Token -> String
(Int -> Token -> ShowS)
-> (Token -> String) -> ([Token] -> ShowS) -> Show Token
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Token] -> ShowS
$cshowList :: [Token] -> ShowS
show :: Token -> String
$cshow :: Token -> String
showsPrec :: Int -> Token -> ShowS
$cshowsPrec :: Int -> Token -> ShowS
Show)


data Fixity
    = Prefix
    | InfixL
    | InfixN
    | InfixR
    | Postfix
    deriving (Fixity -> Fixity -> Bool
(Fixity -> Fixity -> Bool)
-> (Fixity -> Fixity -> Bool) -> Eq Fixity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Fixity -> Fixity -> Bool
$c/= :: Fixity -> Fixity -> Bool
== :: Fixity -> Fixity -> Bool
$c== :: Fixity -> Fixity -> Bool
Eq, Int -> Fixity -> ShowS
[Fixity] -> ShowS
Fixity -> String
(Int -> Fixity -> ShowS)
-> (Fixity -> String) -> ([Fixity] -> ShowS) -> Show Fixity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Fixity] -> ShowS
$cshowList :: [Fixity] -> ShowS
show :: Fixity -> String
$cshow :: Fixity -> String
showsPrec :: Int -> Fixity -> ShowS
$cshowsPrec :: Int -> Fixity -> ShowS
Show)

data Operator
    = Op Fixity Token
    | Apply
    deriving (Operator -> Operator -> Bool
(Operator -> Operator -> Bool)
-> (Operator -> Operator -> Bool) -> Eq Operator
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Operator -> Operator -> Bool
$c/= :: Operator -> Operator -> Bool
== :: Operator -> Operator -> Bool
$c== :: Operator -> Operator -> Bool
Eq, Int -> Operator -> ShowS
[Operator] -> ShowS
Operator -> String
(Int -> Operator -> ShowS)
-> (Operator -> String) -> ([Operator] -> ShowS) -> Show Operator
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Operator] -> ShowS
$cshowList :: [Operator] -> ShowS
show :: Operator -> String
$cshow :: Operator -> String
showsPrec :: Int -> Operator -> ShowS
$cshowsPrec :: Int -> Operator -> ShowS
Show)

-- | A list of lists of operators where lists that come first contain operators
-- that bind more strongly.
operators :: [[Operator]]
operators :: [[Operator]]
operators =
    [ [ Operator
Apply ]
    , [ Fixity -> Token -> Operator
Op Fixity
Prefix Token
TMinus ]
    , [ Fixity -> Token -> Operator
Op Fixity
Postfix Token
TQuestion ]
    , [ Fixity -> Token -> Operator
Op Fixity
InfixR Token
TConcat ]
    , [ Fixity -> Token -> Operator
Op Fixity
InfixL Token
TMul
      , Fixity -> Token -> Operator
Op Fixity
InfixL Token
TDiv ]
    , [ Fixity -> Token -> Operator
Op Fixity
InfixL Token
TPlus
      , Fixity -> Token -> Operator
Op Fixity
InfixL Token
TMinus ]
    , [ Fixity -> Token -> Operator
Op Fixity
Prefix Token
TNot ]
    , [ Fixity -> Token -> Operator
Op Fixity
InfixR Token
TUpdate ]
    , [ Fixity -> Token -> Operator
Op Fixity
InfixN Token
TLess
      , Fixity -> Token -> Operator
Op Fixity
InfixN Token
TGreater
      , Fixity -> Token -> Operator
Op Fixity
InfixN Token
TLessEqual
      , Fixity -> Token -> Operator
Op Fixity
InfixN Token
TGreaterEqual ]
    , [ Fixity -> Token -> Operator
Op Fixity
InfixN Token
TEqual
      , Fixity -> Token -> Operator
Op Fixity
InfixN Token
TUnequal ]
    , [ Fixity -> Token -> Operator
Op Fixity
InfixL Token
TAnd ]
    , [ Fixity -> Token -> Operator
Op Fixity
InfixL Token
TOr ]
    , [ Fixity -> Token -> Operator
Op Fixity
InfixL Token
TImplies ]
    ]

tokenText :: Token -> Text
tokenText :: Token -> Text
tokenText (Identifier Text
i)     = Text
i
tokenText (Integer Int
i)        = String -> Text
pack (Int -> String
forall a. Show a => a -> String
show Int
i)
tokenText (Float Double
f)          = String -> Text
pack (Double -> String
forall a. Show a => a -> String
show Double
f)
tokenText (EnvPath Text
p)        = Text
"<" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
p Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
">"

tokenText Token
KAssert            = Text
"assert"
tokenText Token
KElse              = Text
"else"
tokenText Token
KIf                = Text
"if"
tokenText Token
KIn                = Text
"in"
tokenText Token
KInherit           = Text
"inherit"
tokenText Token
KLet               = Text
"let"
tokenText Token
KOr                = Text
"or"
tokenText Token
KRec               = Text
"rec"
tokenText Token
KThen              = Text
"then"
tokenText Token
KWith              = Text
"with"

tokenText Token
TBraceOpen         = Text
"{"
tokenText Token
TBraceClose        = Text
"}"
tokenText Token
TBrackOpen         = Text
"["
tokenText Token
TBrackClose        = Text
"]"
tokenText Token
TInterOpen         = Text
"${"
tokenText Token
TInterClose        = Text
"}"
tokenText Token
TParenOpen         = Text
"("
tokenText Token
TParenClose        = Text
")"

tokenText Token
TAssign            = Text
"="
tokenText Token
TAt                = Text
"@"
tokenText Token
TColon             = Text
":"
tokenText Token
TComma             = Text
","
tokenText Token
TDot               = Text
"."
tokenText Token
TDoubleQuote       = Text
"\""
tokenText Token
TDoubleSingleQuote = Text
"''"
tokenText Token
TEllipsis          = Text
"..."
tokenText Token
TQuestion          = Text
"?"
tokenText Token
TSemicolon         = Text
";"

tokenText Token
TPlus              = Text
"+"
tokenText Token
TMinus             = Text
"-"
tokenText Token
TMul               = Text
"*"
tokenText Token
TDiv               = Text
"/"
tokenText Token
TConcat            = Text
"++"
tokenText Token
TNegate            = Text
"-"
tokenText Token
TUpdate            = Text
"//"

tokenText Token
TAnd               = Text
"&&"
tokenText Token
TOr                = Text
"||"
tokenText Token
TEqual             = Text
"=="
tokenText Token
TGreater           = Text
">"
tokenText Token
TGreaterEqual      = Text
">="
tokenText Token
TImplies           = Text
"->"
tokenText Token
TLess              = Text
"<"
tokenText Token
TLessEqual         = Text
"<="
tokenText Token
TNot               = Text
"!"
tokenText Token
TUnequal           = Text
"!="

tokenText Token
SOF                = Text
""