83 lines
2.6 KiB
Haskell
83 lines
2.6 KiB
Haskell
{-# LANGUAGE DeriveDataTypeable #-}
|
|
{-# LANGUAGE DeriveGeneric #-}
|
|
{-# LANGUAGE LambdaCase #-}
|
|
|
|
module Nix.Parser.Operators where
|
|
|
|
import Data.Data (Data(..))
|
|
import Data.Foldable (concat)
|
|
import qualified Data.Map as Map
|
|
import Data.Maybe (catMaybes)
|
|
import Data.Typeable (Typeable)
|
|
import GHC.Generics
|
|
import Nix.Expr
|
|
|
|
data NSpecialOp = NHasAttrOp | NSelectOp | NAppOp
|
|
deriving (Eq, Ord, Generic, Typeable, Data, Show)
|
|
|
|
data NAssoc = NAssocNone | NAssocLeft | NAssocRight
|
|
deriving (Eq, Ord, Generic, Typeable, Data, Show)
|
|
|
|
data NOperatorDef
|
|
= NUnaryDef String NUnaryOp
|
|
| NBinaryDef NAssoc [(String, NBinaryOp)]
|
|
deriving (Eq, Ord, Generic, Typeable, Data, Show)
|
|
|
|
nixOperators :: [Either NSpecialOp NOperatorDef]
|
|
nixOperators =
|
|
[ Left NSelectOp
|
|
, Left NAppOp
|
|
, Right $ NUnaryDef "-" NNeg
|
|
, Left NHasAttrOp
|
|
] ++ map Right
|
|
[ NBinaryDef NAssocRight [("++", NConcat)]
|
|
, NBinaryDef NAssocLeft [("*", NMult), ("/", NDiv)]
|
|
, NBinaryDef NAssocLeft [("+", NPlus), ("-", NMinus)]
|
|
, NUnaryDef "!" NNot
|
|
, NBinaryDef NAssocRight [("//", NUpdate)]
|
|
, NBinaryDef NAssocLeft [("<", NLt), (">", NGt), ("<=", NLte), (">=", NGte)]
|
|
, NBinaryDef NAssocNone [("==", NEq), ("!=", NNEq)]
|
|
, NBinaryDef NAssocLeft [("&&", NAnd)]
|
|
, NBinaryDef NAssocLeft [("||", NOr)]
|
|
, NBinaryDef NAssocNone [("->", NImpl)]
|
|
]
|
|
|
|
data OperatorInfo = OperatorInfo
|
|
{ precedence :: Int
|
|
, associativity :: NAssoc
|
|
, operatorName :: String
|
|
} deriving (Eq, Ord, Generic, Typeable, Data, Show)
|
|
|
|
getUnaryOperator :: NUnaryOp -> OperatorInfo
|
|
getUnaryOperator = (m Map.!) where
|
|
m = Map.fromList . concat . zipWith buildEntry [1..] . reverse $
|
|
nixOperators
|
|
buildEntry i = \case
|
|
Right (NUnaryDef name op) -> [(op, OperatorInfo i NAssocNone name)]
|
|
_ -> []
|
|
|
|
getBinaryOperator :: NBinaryOp -> OperatorInfo
|
|
getBinaryOperator = (m Map.!) where
|
|
m = Map.fromList . concat . zipWith buildEntry [1..] . reverse $
|
|
nixOperators
|
|
buildEntry i = \case
|
|
Right (NBinaryDef assoc ops) ->
|
|
[(op, OperatorInfo i assoc name) | (name,op) <- ops]
|
|
_ -> []
|
|
|
|
getSpecialOperatorPrec :: NSpecialOp -> Int
|
|
getSpecialOperatorPrec = (m Map.!) where
|
|
m = Map.fromList . catMaybes . zipWith buildEntry [1..] . reverse $
|
|
nixOperators
|
|
buildEntry _ (Right _) = Nothing
|
|
buildEntry i (Left op) = Just (op, i)
|
|
|
|
selectOp :: OperatorInfo
|
|
selectOp = OperatorInfo (getSpecialOperatorPrec NSelectOp) NAssocLeft "."
|
|
|
|
hasAttrOp :: OperatorInfo
|
|
hasAttrOp = OperatorInfo (getSpecialOperatorPrec NHasAttrOp) NAssocLeft "?"
|
|
|
|
appOp :: OperatorInfo
|
|
appOp = OperatorInfo (getSpecialOperatorPrec NAppOp) NAssocLeft " "
|