2018-04-09 11:07:40 +02:00
|
|
|
{-# LANGUAGE DeriveAnyClass #-}
|
2018-04-07 21:02:50 +02:00
|
|
|
{-# LANGUAGE DeriveDataTypeable #-}
|
|
|
|
{-# LANGUAGE DeriveFoldable #-}
|
|
|
|
{-# LANGUAGE DeriveFunctor #-}
|
|
|
|
{-# LANGUAGE DeriveGeneric #-}
|
|
|
|
{-# LANGUAGE DeriveTraversable #-}
|
|
|
|
{-# LANGUAGE FlexibleInstances #-}
|
|
|
|
{-# LANGUAGE KindSignatures #-}
|
|
|
|
{-# LANGUAGE LambdaCase #-}
|
|
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
{-# LANGUAGE PatternSynonyms #-}
|
|
|
|
{-# LANGUAGE RankNTypes #-}
|
|
|
|
{-# LANGUAGE TemplateHaskell #-}
|
|
|
|
|
|
|
|
-- | The source location annotated nix expression type and supporting types.
|
|
|
|
--
|
|
|
|
module Nix.Expr.Types.Annotated
|
|
|
|
( module Nix.Expr.Types.Annotated
|
2018-04-10 02:12:16 +02:00
|
|
|
, SourcePos(..), unPos
|
2018-04-07 21:02:50 +02:00
|
|
|
)where
|
|
|
|
|
2018-04-12 02:59:42 +02:00
|
|
|
import Codec.Serialise
|
2018-04-09 11:07:40 +02:00
|
|
|
import Control.DeepSeq
|
2018-04-07 21:02:50 +02:00
|
|
|
import Data.Data
|
|
|
|
import Data.Fix
|
|
|
|
import Data.Function (on)
|
|
|
|
import Data.Functor.Compose
|
|
|
|
import Data.Semigroup
|
2018-04-08 01:33:50 +02:00
|
|
|
import Data.Text (Text, pack)
|
2018-04-07 21:02:50 +02:00
|
|
|
import GHC.Generics
|
|
|
|
import Nix.Expr.Types
|
2018-04-10 01:11:31 +02:00
|
|
|
import Nix.Parser.Library (SourcePos(..))
|
2018-04-07 21:02:50 +02:00
|
|
|
import Text.Show.Deriving
|
2018-04-10 01:11:31 +02:00
|
|
|
import Text.Megaparsec (unPos)
|
2018-04-07 21:02:50 +02:00
|
|
|
|
|
|
|
-- | A location in a source file
|
2018-04-10 01:11:31 +02:00
|
|
|
data SrcSpan = SrcSpan{ spanBegin :: SourcePos
|
|
|
|
, spanEnd :: SourcePos
|
2018-04-07 21:02:50 +02:00
|
|
|
}
|
2018-04-12 02:59:42 +02:00
|
|
|
deriving (Ord, Eq, Generic, Typeable, Data, Show, NFData, Serialise)
|
2018-04-07 21:02:50 +02:00
|
|
|
|
|
|
|
-- | A type constructor applied to a type along with an annotation
|
|
|
|
--
|
|
|
|
-- Intended to be used with 'Fix':
|
|
|
|
-- @type MyType = Fix (Compose (Ann Annotation) F)@
|
|
|
|
data Ann ann a = Ann{ annotation :: ann
|
|
|
|
, annotated :: a
|
|
|
|
}
|
2018-04-09 11:07:40 +02:00
|
|
|
deriving (Ord, Eq, Data, Generic, Generic1, Typeable, Functor,
|
2018-04-12 02:59:42 +02:00
|
|
|
Foldable, Traversable, Read, Show, NFData, NFData1, Serialise)
|
2018-04-07 21:02:50 +02:00
|
|
|
|
|
|
|
$(deriveShow1 ''Ann)
|
|
|
|
|
|
|
|
instance Semigroup SrcSpan where
|
|
|
|
s1 <> s2 = SrcSpan ((min `on` spanBegin) s1 s2)
|
|
|
|
((max `on` spanEnd) s1 s2)
|
|
|
|
|
|
|
|
type AnnF ann f = Compose (Ann ann) f
|
|
|
|
|
|
|
|
annToAnnF :: Ann ann (f (Fix (AnnF ann f))) -> Fix (AnnF ann f)
|
|
|
|
annToAnnF (Ann ann a) = AnnE ann a
|
|
|
|
|
|
|
|
type NExprLocF = AnnF SrcSpan NExprF
|
|
|
|
|
|
|
|
-- | A nix expression with source location at each subexpression.
|
|
|
|
type NExprLoc = Fix NExprLocF
|
|
|
|
|
2018-04-09 11:07:40 +02:00
|
|
|
instance NFData NExprLoc
|
2018-04-12 02:59:42 +02:00
|
|
|
instance Serialise NExprLoc
|
|
|
|
|
|
|
|
instance Serialise r => Serialise (Compose (Ann SrcSpan) NExprF r) where
|
|
|
|
encode (Compose (Ann ann a)) = encode ann <> encode a
|
|
|
|
decode = (Compose .) . Ann <$> decode <*> decode
|
2018-04-09 11:07:40 +02:00
|
|
|
|
2018-04-07 21:02:50 +02:00
|
|
|
pattern AnnE :: forall ann (g :: * -> *). ann
|
|
|
|
-> g (Fix (Compose (Ann ann) g)) -> Fix (Compose (Ann ann) g)
|
|
|
|
pattern AnnE ann a = Fix (Compose (Ann ann a))
|
|
|
|
|
|
|
|
stripAnnotation :: Functor f => Fix (AnnF ann f) -> Fix f
|
|
|
|
stripAnnotation = ana (annotated . getCompose . unFix)
|
|
|
|
|
|
|
|
nUnary :: Ann SrcSpan NUnaryOp -> NExprLoc -> NExprLoc
|
|
|
|
nUnary (Ann s1 u) e1@(AnnE s2 _) = AnnE (s1 <> s2) (NUnary u e1)
|
|
|
|
nUnary _ _ = error "nUnary: unexpected"
|
|
|
|
|
|
|
|
nBinary :: Ann SrcSpan NBinaryOp -> NExprLoc -> NExprLoc -> NExprLoc
|
|
|
|
nBinary (Ann s1 b) e1@(AnnE s2 _) e2@(AnnE s3 _) =
|
|
|
|
AnnE (s1 <> s2 <> s3) (NBinary b e1 e2)
|
|
|
|
nBinary _ _ _ = error "nBinary: unexpected"
|
|
|
|
|
2018-04-10 02:12:16 +02:00
|
|
|
nSelectLoc :: NExprLoc -> Ann SrcSpan (NAttrPath NExprLoc) -> Maybe NExprLoc
|
|
|
|
-> NExprLoc
|
|
|
|
nSelectLoc e1@(AnnE s1 _) (Ann s2 ats) d = case d of
|
|
|
|
Nothing -> AnnE (s1 <> s2) (NSelect e1 ats Nothing)
|
|
|
|
Just (e2@(AnnE s3 _)) -> AnnE (s1 <> s2 <> s3) (NSelect e1 ats (Just e2))
|
|
|
|
_ -> error "nSelectLoc: unexpected"
|
|
|
|
nSelectLoc _ _ _ = error "nSelectLoc: unexpected"
|
|
|
|
|
|
|
|
nHasAttr :: NExprLoc -> Ann SrcSpan (NAttrPath NExprLoc) -> NExprLoc
|
|
|
|
nHasAttr e1@(AnnE s1 _) (Ann s2 ats) = AnnE (s1 <> s2) (NHasAttr e1 ats)
|
|
|
|
nHasAttr _ _ = error "nHasAttr: unexpected"
|
|
|
|
|
2018-04-10 06:35:46 +02:00
|
|
|
nApp :: NExprLoc -> NExprLoc -> NExprLoc
|
|
|
|
nApp e1@(AnnE s1 _) e2@(AnnE s2 _) = AnnE (s1 <> s2) (NBinary NApp e1 e2)
|
|
|
|
nApp _ _ = error "nApp: unexpected"
|
|
|
|
|
2018-04-07 21:02:50 +02:00
|
|
|
nAbs :: Ann SrcSpan (Params NExprLoc) -> NExprLoc -> NExprLoc
|
|
|
|
nAbs (Ann s1 ps) e1@(AnnE s2 _) = AnnE (s1 <> s2) (NAbs ps e1)
|
|
|
|
nAbs _ _ = error "nAbs: unexpected"
|
|
|
|
|
|
|
|
nStr :: Ann SrcSpan (NString NExprLoc) -> NExprLoc
|
|
|
|
nStr (Ann s1 s) = AnnE s1 (NStr s)
|
2018-04-08 01:33:50 +02:00
|
|
|
|
2018-04-10 01:11:31 +02:00
|
|
|
deltaInfo :: SourcePos -> (Text, Int, Int)
|
|
|
|
deltaInfo (SourcePos fp l c) = (pack fp, unPos l, unPos c)
|