Implement Annotation support functions
This commit is contained in:
Joe Hermaszewski
parent
850125ed54
commit
c11aad7253
|
|
@ -1,10 +1,10 @@
|
|||
{-# LANGUAGE DeriveDataTypeable #-}
|
||||
{-# LANGUAGE DeriveFunctor #-}
|
||||
{-# LANGUAGE PatternSynonyms #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE StandaloneDeriving #-}
|
||||
-- | The source location annotated nix expression type and supporting types.
|
||||
--
|
||||
module Nix.Expr.Types.Annotated where
|
||||
|
|
@ -12,18 +12,20 @@ module Nix.Expr.Types.Annotated where
|
|||
import Control.Monad hiding (forM_, mapM, sequence)
|
||||
import Data.Data
|
||||
import Data.Fix
|
||||
import Data.Function (on)
|
||||
import Data.Functor.Compose
|
||||
import GHC.Exts
|
||||
import Data.Semigroup
|
||||
import GHC.Generics
|
||||
import Nix.Expr.Types
|
||||
import Nix.Parser.Library (Delta)
|
||||
import Prelude hiding (concat, concatMap, elem, foldr,
|
||||
mapM, minimum, readFile, sequence)
|
||||
|
||||
-- | A location in a source file
|
||||
data SrcLoc = SrcLoc{ line :: Int
|
||||
, column :: Int
|
||||
}
|
||||
deriving (Ord, Eq, Generic, Typeable, Data, Read, Show)
|
||||
data SrcSpan = SrcSpan{ spanBegin :: Delta
|
||||
, spanEnd :: Delta
|
||||
}
|
||||
deriving (Ord, Eq, Generic, Typeable, Data, Show)
|
||||
|
||||
-- | A type constructor applied to a type along with an annotation
|
||||
--
|
||||
|
|
@ -42,43 +44,40 @@ annFToAnn = undefined
|
|||
annToAnnF :: Ann ann (f (Fix (AnnF ann f))) -> Fix (AnnF ann f)
|
||||
annToAnnF (Ann ann a) = Fix (Compose (Ann ann a))
|
||||
|
||||
type NExprLocF = AnnF SrcLoc NExprF
|
||||
type NExprLocF = AnnF SrcSpan NExprF
|
||||
|
||||
-- | A nix expression with source location at each subexpression.
|
||||
type NExprLoc = Fix NExprLocF
|
||||
|
||||
pattern AnnE span exp = Fix (Compose (Ann span exp))
|
||||
|
||||
stripAnnotation :: Functor f => Fix (AnnF ann f) -> Fix f
|
||||
stripAnnotation = ana (annotated . getCompose . unFix)
|
||||
|
||||
-- mergeSpans2 :: (a -> b -> c)
|
||||
-- -> (Ann SrcLoc a -> Ann SrcLoc b -> Ann SrcLoc c)
|
||||
-- mergeSpans2 = undefined
|
||||
|
||||
-- mergeSpansE2 :: (NExpr -> NExpr -> NExprF NExpr)
|
||||
-- -> (NExprLoc -> NExprLoc -> NExprLoc)
|
||||
-- mergeSpansE2 = undefined
|
||||
|
||||
-- mergeSpans3 :: (a -> b -> c -> d)
|
||||
-- -> (Ann SrcLoc a -> Ann SrcLoc b -> Ann SrcLoc c -> Ann SrcLoc d)
|
||||
-- mergeSpans3 = undefined
|
||||
instance Semigroup SrcSpan where
|
||||
s1 <> s2 = SrcSpan ((min `on` spanBegin) s1 s2)
|
||||
((max `on` spanEnd) s1 s2)
|
||||
|
||||
nApp :: NExprLoc -> NExprLoc -> NExprLoc
|
||||
nApp = undefined
|
||||
nApp e1@(AnnE s1 _) e2@(AnnE s2 _) = AnnE (s1 <> s2) (NApp e1 e2)
|
||||
|
||||
nUnary :: Ann SrcLoc NUnaryOp -> NExprLoc -> NExprLoc
|
||||
nUnary = undefined
|
||||
nUnary :: Ann SrcSpan NUnaryOp -> NExprLoc -> NExprLoc
|
||||
nUnary (Ann s1 u) e1@(AnnE s2 _) = AnnE (s1 <> s2) (NUnary u e1)
|
||||
|
||||
nBinary :: Ann SrcLoc NBinaryOp -> NExprLoc -> NExprLoc -> NExprLoc
|
||||
nBinary = undefined
|
||||
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)
|
||||
|
||||
nSelectLoc :: NExprLoc -> Ann SrcLoc (NAttrPath NExprLoc) -> Maybe NExprLoc -> NExprLoc
|
||||
nSelectLoc = undefined
|
||||
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))
|
||||
|
||||
nHasAttr :: NExprLoc -> Ann SrcLoc (NAttrPath NExprLoc) -> NExprLoc
|
||||
nHasAttr = undefined
|
||||
nHasAttr :: NExprLoc -> Ann SrcSpan (NAttrPath NExprLoc) -> NExprLoc
|
||||
nHasAttr e1@(AnnE s1 _) (Ann s2 ats) = AnnE (s1 <> s2) (NHasAttr e1 ats)
|
||||
|
||||
nAbs :: Ann SrcLoc (Params NExprLoc) -> NExprLoc -> NExprLoc
|
||||
nAbs = undefined
|
||||
nAbs :: Ann SrcSpan (Params NExprLoc) -> NExprLoc -> NExprLoc
|
||||
nAbs (Ann s1 ps) e1@(AnnE s2 _) = AnnE (s1 <> s2) (NAbs ps e1)
|
||||
|
||||
nStr :: NString NExprLoc -> NExprLoc
|
||||
nStr = undefined
|
||||
nStr :: Ann SrcSpan (NString NExprLoc) -> NExprLoc
|
||||
nStr (Ann s1 s) = AnnE s1 (NStr s)
|
||||
|
|
|
|||
|
|
@ -23,11 +23,17 @@ import Prelude hiding (elem)
|
|||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
annotateLocation :: Parser a -> Parser (Ann SrcLoc a)
|
||||
annotateLocation = undefined
|
||||
annotateLocation :: Parser a -> Parser (Ann SrcSpan a)
|
||||
annotateLocation p = do
|
||||
whiteSpace
|
||||
begin <- position
|
||||
res <- p
|
||||
end <- position
|
||||
let span = SrcSpan begin end
|
||||
pure $ Ann span res
|
||||
|
||||
annotateLocation1 :: Parser (NExprF NExprLoc) -> Parser NExprLoc
|
||||
annotateLocation1 = undefined
|
||||
annotateLocation1 = fmap annToAnnF . annotateLocation
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
|
|
@ -44,7 +50,7 @@ nixExprLoc = whiteSpace *> (nixToplevelForm <|> foldl' makeParser nixTerm nixOpe
|
|||
makeParser term (Left NHasAttrOp) = nixHasAttr term
|
||||
makeParser term (Right (NUnaryDef name op))
|
||||
= build <$> many (annotateLocation (void $ symbol name)) <*> term
|
||||
where build :: [Ann SrcLoc ()] -> NExprLoc -> NExprLoc
|
||||
where build :: [Ann SrcSpan ()] -> NExprLoc -> NExprLoc
|
||||
build = flip $ foldl' (\t' (Ann s ()) -> nUnary (Ann s op) t')
|
||||
makeParser term (Right (NBinaryDef assoc ops)) = case assoc of
|
||||
NAssocLeft -> chainl1 term op
|
||||
|
|
@ -63,7 +69,7 @@ selDot :: Parser ()
|
|||
selDot = try (char '.' *> notFollowedBy (("path" :: String) <$ nixPath)) *> whiteSpace
|
||||
<?> "."
|
||||
|
||||
nixSelector :: Parser (Ann SrcLoc (NAttrPath NExprLoc))
|
||||
nixSelector :: Parser (Ann SrcSpan (NAttrPath NExprLoc))
|
||||
nixSelector = annotateLocation $ keyName `sepBy1` selDot
|
||||
|
||||
nixSelect :: Parser NExprLoc -> Parser NExprLoc
|
||||
|
|
@ -71,13 +77,13 @@ nixSelect term = build
|
|||
<$> term
|
||||
<*> optional ((,) <$> (selDot *> nixSelector) <*> optional (reserved "or" *> nixExprLoc))
|
||||
where
|
||||
build :: NExprLoc -> Maybe (Ann SrcLoc (NAttrPath NExprLoc), Maybe NExprLoc) -> NExprLoc
|
||||
build :: NExprLoc -> Maybe (Ann SrcSpan (NAttrPath NExprLoc), Maybe NExprLoc) -> NExprLoc
|
||||
build t Nothing = t
|
||||
build t (Just (s,o)) = nSelectLoc t s o
|
||||
|
||||
nixHasAttr :: Parser NExprLoc -> Parser NExprLoc
|
||||
nixHasAttr term = build <$> term <*> optional (reservedOp "?" *> nixSelector) where
|
||||
build :: NExprLoc -> Maybe (Ann SrcLoc (NAttrPath NExprLoc)) -> NExprLoc
|
||||
build :: NExprLoc -> Maybe (Ann SrcSpan (NAttrPath NExprLoc)) -> NExprLoc
|
||||
build t Nothing = t
|
||||
build t (Just s) = nHasAttr t s
|
||||
|
||||
|
|
@ -159,7 +165,7 @@ nixLambda :: Parser NExprLoc
|
|||
nixLambda = (nAbs <$> annotateLocation (try argExpr <?> "lambda arguments") <*> nixExprLoc) <?> "lambda"
|
||||
|
||||
nixStringExpr :: Parser NExprLoc
|
||||
nixStringExpr = nStr <$> nixString
|
||||
nixStringExpr = nStr <$> annotateLocation nixString
|
||||
|
||||
uriAfterColonC :: Parser Char
|
||||
uriAfterColonC = alphaNum <|> oneOf "%/?:@&=+$,-_.!~*'"
|
||||
|
|
@ -251,7 +257,7 @@ argExpr = choice [atLeft, onlyname, atRight] <* symbolic ':' where
|
|||
nixBinders :: Parser [Binding NExprLoc]
|
||||
nixBinders = (inherit <|> namedVar) `endBy` symbolic ';' where
|
||||
inherit = Inherit <$> (reserved "inherit" *> optional scope)
|
||||
<*> many (keyName)
|
||||
<*> many keyName
|
||||
<?> "inherited binding"
|
||||
namedVar = NamedVar <$> (annotated <$> nixSelector) <*> (symbolic '=' *> nixExprLoc)
|
||||
<?> "variable binding"
|
||||
|
|
|
|||
|
|
@ -1,7 +1,11 @@
|
|||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
module Nix.Parser.Library ( module Nix.Parser.Library, module X) where
|
||||
module Nix.Parser.Library
|
||||
( module Nix.Parser.Library
|
||||
, module X
|
||||
, Trifecta.Delta
|
||||
) where
|
||||
|
||||
import Prelude
|
||||
import Control.Applicative
|
||||
|
|
@ -31,7 +35,7 @@ import Text.Trifecta as X (Result(..))
|
|||
#endif
|
||||
|
||||
newtype NixParser p a = NixParser { runNixParser :: p a }
|
||||
deriving (Functor, Applicative, Alternative, Monad, MonadPlus, Parsing, CharParsing, LookAheadParsing)
|
||||
deriving (Functor, Applicative, Alternative, Monad, MonadPlus, Parsing, CharParsing, LookAheadParsing, Trifecta.DeltaParsing)
|
||||
|
||||
instance TokenParsing p => TokenParsing (NixParser p) where
|
||||
someSpace = NixParser $ buildSomeSpaceParser someSpace commentStyle
|
||||
|
|
@ -104,6 +108,7 @@ someTill p end = go
|
|||
--------------------------------------------------------------------------------
|
||||
parseFromFileEx :: MonadIO m => Parser a -> FilePath -> m (Result a)
|
||||
parseFromString :: Parser a -> String -> Result a
|
||||
position :: Parser Trifecta.Delta
|
||||
|
||||
#if USE_PARSEC
|
||||
data Result a = Success a
|
||||
|
|
@ -118,6 +123,8 @@ parseFromFileEx p path =
|
|||
|
||||
parseFromString p = either (Failure . text . show) Success . Parsec.parse (runNixParser p) "<string>" . pack
|
||||
|
||||
position = error "position not implemented for Parsec parser"
|
||||
|
||||
#else
|
||||
|
||||
type Parser = NixParser Trifecta.Parser
|
||||
|
|
@ -125,4 +132,7 @@ type Parser = NixParser Trifecta.Parser
|
|||
parseFromFileEx p = Trifecta.parseFromFileEx (runNixParser p)
|
||||
|
||||
parseFromString p = Trifecta.parseString (runNixParser p) (Trifecta.Directed "<string>" 0 0 0 0)
|
||||
|
||||
position = Trifecta.position
|
||||
|
||||
#endif
|
||||
|
|
|
|||
|
|
@ -59,6 +59,7 @@ Library
|
|||
, unordered-containers
|
||||
, data-fix
|
||||
, deepseq
|
||||
, semigroups >= 0.18 && < 0.19
|
||||
if flag(parsec)
|
||||
Cpp-options: -DUSE_PARSEC
|
||||
Build-depends: parsec
|
||||
|
|
|
|||
Loading…
Reference in a new issue