WIP

src/Nixfmt.hs

@@ -17,15 +17,15 @@ import Data.Text.Lazy (toStrict)
 import qualified Nixfmt.Parser as Parser
 import Nixfmt.Predoc (Pretty)
 import Nixfmt.Pretty ()
-import Nixfmt.Types (Expression, LanguageElement, ParseErrorBundle, Whole (..), walkSubprograms)
+import Nixfmt.Types (Expression, ParseErrorBundle, Whole (..), walkSubprograms, Leaf)
 import qualified Text.Megaparsec as Megaparsec (parse)
 import Text.Megaparsec.Error (errorBundlePretty)
 import Text.Pretty.Simple (pShow)
 
 -- import Debug.Trace (traceShow, traceShowId)
 
 type Width = Int
-type Layouter = forall a. (Pretty a, LanguageElement a) => a -> Text
+type Layouter = forall e. (Pretty (e Leaf), Functor e) => e Leaf -> Text
 
 -- | @format w filename source@ returns either a parsing error specifying a
 -- failure in @filename@ or a formatted version of @source@ with a maximum width

src/Nixfmt/Lexer.hs

@@ -201,7 +201,7 @@ lexeme p = do
 -- | Tokens normally have only leading trivia and one trailing comment on the same
 -- line. A whole x also parses and stores final trivia after the x. A whole also
 -- does not interact with the trivia state of its surroundings.
-whole :: Parser a -> Parsec Void Text (Whole a)
+whole :: Parser (e a) -> Parsec Void Text (Whole e a)
 whole pa = flip evalStateT [] do
   preLexeme $ pure ()
   pushTrivia . convertLeading =<< trivia

src/Nixfmt/Parser.hs

@@ -1,5 +1,6 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TupleSections #-}
 
 module Nixfmt.Parser where
 
@@ -21,22 +22,30 @@ import Nixfmt.Lexer (lexeme, takeTrivia, whole)
 import Nixfmt.Parser.Float (floatParse)
 import Nixfmt.Types (
   Ann (..),
-  Binder (..),
-  Expression (..),
+  BinderF (..),
+  Binder,
+  ExpressionF (..),
+  Expression,
   File,
   Fixity (..),
   Item (..),
   Items (..),
   Leaf,
   Operator (..),
-  ParamAttr (..),
-  Parameter (..),
+  ParamAttrF (..),
+  ParamAttr,
+  ParameterF (..),
+  Parameter,
   Parser,
   Path,
-  Selector (..),
-  SimpleSelector (..),
-  StringPart (..),
-  Term (..),
+  SelectorF(..),
+  Selector,
+  SimpleSelectorF(..),
+  SimpleSelector,
+  StringPartF(..),
+  StringPart,
+  TermF (..),
+  Term,
   Token (..),
   Whole (..),
   operators,
@@ -69,11 +78,13 @@ import Text.Megaparsec (
   satisfy,
   some,
   try,
-  (<|>),
+  (<|>), parse, errorBundlePretty,
  )
 import Text.Megaparsec.Char (char)
 import qualified Text.Megaparsec.Char.Lexer as L (decimal)
 import Prelude hiding (String)
+import Data.Bifunctor (Bifunctor(bimap))
+import Text.Pretty.Simple (pPrint)
 
 -- HELPER FUNCTIONS
 
@@ -141,23 +152,22 @@ envPath =
       <* char '>'
 
 pathText :: Parser StringPart
-pathText = TextPart <$> someP pathChar
+pathText = TextPart <$> lexeme (String <$> someP pathChar)
 
 pathTraversal :: Parser [StringPart]
-pathTraversal = liftM2 (:) (TextPart <$> slash) (some (pathText <|> interpolation))
+pathTraversal = liftM2 (:) (TextPart <$> lexeme slash) (some (pathText <|> interpolation))
 
 path :: Parser Path
 path =
   try $
-    lexeme $
       fmap normalizeLine $
         (maybeToList <$> optional pathText) <> (concat <$> some pathTraversal)
 
-uri :: Parser [[StringPart]]
+uri :: Parser [StringPart]
 uri =
-  fmap (pure . pure . TextPart) $
-    try $
-      someP schemeChar <> chunk ":" <> someP uriChar
+  fmap (pure . TextPart) $ lexeme $
+    try $ String <$>
+      (someP schemeChar <> chunk ":" <> someP uriChar)
 
 -- STRINGS
 
@@ -175,18 +185,31 @@ interpolationRestricted = do
     Interpolation (Whole (Term (SimpleString _)) _) -> pure interpol
     _ -> empty
 
-simpleStringPart :: Parser StringPart
-simpleStringPart =
-  TextPart
-    <$> someText
-      ( chunk "\\n"
-          <|> chunk "\\r"
-          <|> chunk "\\t"
-          <|> ((<>) <$> chunk "\\" <*> (Text.singleton <$> anySingle))
-          <|> chunk "$$"
-          <|> try (chunk "$" <* notFollowedBy (char '{'))
-          <|> someP (\t -> t /= '"' && t /= '\\' && t /= '$')
-      )
+simpleStringPart :: Parser Text -> Parser (Bool, StringPart)
+simpleStringPart opening = do
+  l@Ann { value = (inter, value') } <- lexeme individual
+  return (inter, TextPart l { value = value' })
+  where
+    individual = do
+      open <- opening
+      chars <- manyText
+          ( chunk "\\n"
+              <|> chunk "\\r"
+              <|> chunk "\\t"
+              <|> (chunk "\\" <> (Text.singleton <$> anySingle))
+              <|> chunk "$$"
+              <|> try (chunk "$" <* notFollowedBy (char '{'))
+              <|> try (someP (\t -> t /= '"' && t /= '\\' && t /= '$'))
+          )
+      (inter, close) <- ((False,) <$> chunk "\"") <|> ((True,) <$> chunk "${")
+      return (inter, String (open <> chars <> close))
+  --TextPart <$> lexeme (String
+  --  <$> (
+  --  chunk "\""
+  --  <>
+  --  <>
+  --  (chunk "\"" <|> (chunk "${" <> interpolation <> chunk "}" <> started))
+  --  ))
 
 indentedStringPart :: Parser StringPart
 indentedStringPart =
@@ -275,17 +298,17 @@ stripParts _ xs = xs
 
 -- | Split a list of StringParts on the newlines in their TextParts.
 -- Invariant: result is never empty.
-splitLines :: [StringPart] -> [[StringPart]]
-splitLines [] = [[]]
-splitLines (TextPart t : xs) =
-  let ts = map (pure . TextPart) $ Text.split (== '\n') t
-  in case splitLines xs of
-      (xs' : xss) -> init ts ++ ((last ts ++ xs') : xss)
-      _ -> error "unreachable"
-splitLines (x : xs) =
-  case splitLines xs of
-    (xs' : xss) -> (x : xs') : xss
-    _ -> error "unreachable"
+--splitLines :: [StringPart] -> [[StringPart]]
+--splitLines [] = [[]]
+--splitLines (TextPart t : xs) =
+--  let ts = map (pure . TextPart) $ Text.split (== '\n') t
+--  in case splitLines xs of
+--      (xs' : xss) -> init ts ++ ((last ts ++ xs') : xss)
+--      _ -> error "unreachable"
+--splitLines (x : xs) =
+--  case splitLines xs of
+--    (xs' : xss) -> (x : xs') : xss
+--    _ -> error "unreachable"
 
 stripIndentation :: [[StringPart]] -> [[StringPart]]
 stripIndentation parts = case commonIndentation $ mapMaybe lineHead parts of
@@ -298,14 +321,29 @@ normalizeLine (TextPart "" : xs) = normalizeLine xs
 normalizeLine (TextPart x : TextPart y : xs) = normalizeLine (TextPart (x <> y) : xs)
 normalizeLine (x : xs) = x : normalizeLine xs
 
-fixSimpleString :: [StringPart] -> [[StringPart]]
-fixSimpleString = map normalizeLine . splitLines
+--fixSimpleString :: [StringPart] -> [[StringPart]]
+--fixSimpleString = map normalizeLine . splitLines
+
 
-simpleString :: Parser [[StringPart]]
-simpleString =
-  rawSymbol TDoubleQuote
-    *> fmap fixSimpleString (many (simpleStringPart <|> interpolation))
-    <* rawSymbol TDoubleQuote
+test s = either (putStrLn . errorBundlePretty) pPrint $ parse (whole simpleString) "f" s
+
+simpleString :: Parser [StringPart]
+simpleString = do
+  go (chunk "\"")
+  where
+    go :: Parser Text -> Parser [StringPart]
+    go open = do
+      (inter, s) <- simpleStringPart open
+      if inter then
+        do
+          i <- Interpolation <$> lift (whole expression)
+          rest <- go (chunk "}")
+          return $ s : i : rest
+      else
+        return [ s ]
+  --rawSymbol TDoubleQuote
+  --  *> fmap fixSimpleString (many (simpleStringPart <|> interpolation))
+  --  <* rawSymbol TDoubleQuote
 
 fixIndentedString :: [[StringPart]] -> [[StringPart]]
 fixIndentedString =
@@ -334,7 +372,7 @@ simpleSelector :: Parser StringPart -> Parser SimpleSelector
 simpleSelector parseInterpolation =
   (IDSelector <$> identifier)
     <|> (InterpolSelector <$> lexeme parseInterpolation)
-    <|> (StringSelector <$> lexeme simpleString)
+    <|> (StringSelector <$> simpleString)
 
 selector :: Maybe (Parser Leaf) -> Parser Selector
 selector parseDot =
@@ -355,9 +393,9 @@ selectorPath' = many $ try $ selector $ Just $ symbol TDot
 -- Everything but selection
 simpleTerm :: Parser Term
 simpleTerm =
-  (SimpleString <$> lexeme (simpleString <|> uri))
-    <|> (IndentedString <$> lexeme indentedString)
-    <|> (Path <$> path)
+  (SimpleString <$> (simpleString {-<|> uri-}))
+    <|> (IndentedString <$> indentedString)
+    -- <|> (Path <$> path)
     <|> (Token <$> (envPath <|> float <|> integer <|> identifier))
     <|> parens
     <|> set

src/Nixfmt/Predoc.hs

@@ -47,8 +47,7 @@ import Data.Text as Text (Text, concat, length, replicate, strip)
 import GHC.Stack (HasCallStack)
 import Nixfmt.Types (
   LanguageElement,
-  mapAllTokens,
-  removeLineInfo,
+  removeLineInfo, Leaf,
  )
 
 -- | Sequential Spacings are reduced to a single Spacing by taking the maximum.
@@ -347,15 +346,15 @@ mergeSpacings Hardspace (Newlines x) = Newlines x
 mergeSpacings _ (Newlines x) = Newlines (x + 1)
 mergeSpacings _ y = y
 
-layout :: (Pretty a, LanguageElement a) => Int -> Bool -> a -> Text
+layout :: (Pretty (e Leaf), Functor e) => Int -> Bool -> e Leaf -> Text
 layout width pure_ =
   (<> "\n")
     . Text.strip
     . layoutGreedy width
     . fixup
     . pretty
     -- In pure mode, set the line number of all tokens to zero
-    . (if pure_ then mapAllTokens removeLineInfo else id)
+    . (if pure_ then fmap removeLineInfo else id)
 
 -- 1. Move and merge Spacings.
 -- 2. Convert Softlines to Grouped Lines and Hardspaces to Texts.

src/Nixfmt/Pretty.hs

@@ -4,6 +4,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE TupleSections #-}
+{-# LANGUAGE FlexibleContexts #-}
 
 module Nixfmt.Pretty where
 
@@ -40,17 +41,24 @@ import Nixfmt.Predoc (
  )
 import Nixfmt.Types (
   Ann (..),
-  Binder (..),
-  Expression (..),
+  BinderF (..),
+  Binder,
+  ExpressionF (..),
+  Expression,
   Item (..),
   Items (..),
   Leaf,
-  ParamAttr (..),
-  Parameter (..),
-  Selector (..),
-  SimpleSelector (..),
-  StringPart (..),
-  Term (..),
+  ParamAttrF (..),
+  ParamAttr,
+  ParameterF (..),
+  Parameter,
+  SelectorF (..),
+  Selector,
+  SimpleSelectorF (..),
+  StringPartF (..),
+  StringPart,
+  TermF (..),
+  Term,
   Token (..),
   TrailingComment (..),
   Trivium (..),
@@ -112,7 +120,7 @@ instance (Pretty a) => Pretty (Ann a) where
   pretty Ann{preTrivia, value, trailComment} =
     pretty preTrivia <> pretty value <> pretty trailComment
 
-instance Pretty SimpleSelector where
+instance Pretty (SimpleSelectorF Leaf) where
   pretty (IDSelector i) = pretty i
   pretty (InterpolSelector interpol) = pretty interpol
   pretty (StringSelector Ann{preTrivia, value, trailComment}) =
@@ -691,7 +699,7 @@ instance Pretty Expression where
   pretty (Inversion bang expr) =
     pretty bang <> pretty expr
 
-instance (Pretty a) => Pretty (Whole a) where
+instance (Pretty (e a)) => Pretty (Whole e a) where
   pretty (Whole x finalTrivia) =
     group $ pretty x <> pretty finalTrivia
 
@@ -718,7 +726,7 @@ isSimple _ = False
 -- STRINGS
 
 instance Pretty StringPart where
-  pretty (TextPart t) = text t
+  pretty (TextPart t) = pretty t
   -- Absorb terms
   -- This is exceedingly rare (why would one do this anyways?); one instance in the entire Nixpkgs
   pretty (Interpolation (Whole (Term t) []))
@@ -769,9 +777,9 @@ instance Pretty [StringPart] where
   -- interpolations, make sure to indent based on the indentation of the line
   -- in the string.
   pretty (TextPart t : parts) =
-    text t <> offset indentation (hcat parts)
+    pretty t <> offset indentation (hcat parts)
     where
-      indentation = textWidth $ Text.takeWhile isSpace t
+      indentation = textWidth $ Text.takeWhile isSpace (tokenText $ value t)
   pretty parts = hcat parts
 
 prettySimpleString :: [[StringPart]] -> Doc