-- | Functions for manipulating nix strings.
module Nix.Expr.Strings where

import           Nix.Prelude
import           Relude.Unsafe                 as Unsafe
-- Please, switch things to NonEmpty
import           Data.List                      ( dropWhileEnd
                                                , minimum
                                                , lookup
                                                )
import qualified Data.Text                     as T
import           Nix.Expr.Types

-- | Merge adjacent @Plain@ values with @<>@.
mergePlain :: [Antiquoted Text r] -> [Antiquoted Text r]
mergePlain :: forall r. [Antiquoted Text r] -> [Antiquoted Text r]
mergePlain [] = forall a. Monoid a => a
mempty
mergePlain (Plain Text
a : Antiquoted Text r
EscapedNewline : Plain Text
b : [Antiquoted Text r]
xs) =
  forall r. [Antiquoted Text r] -> [Antiquoted Text r]
mergePlain (forall v r. v -> Antiquoted v r
Plain (Text
a forall a. Semigroup a => a -> a -> a
<> Text
"\n" forall a. Semigroup a => a -> a -> a
<> Text
b) forall a. a -> [a] -> [a]
: [Antiquoted Text r]
xs)
mergePlain (Plain Text
a : Plain Text
b : [Antiquoted Text r]
xs) = forall r. [Antiquoted Text r] -> [Antiquoted Text r]
mergePlain (forall v r. v -> Antiquoted v r
Plain (Text
a forall a. Semigroup a => a -> a -> a
<> Text
b) forall a. a -> [a] -> [a]
: [Antiquoted Text r]
xs)
mergePlain (Antiquoted Text r
x                 : [Antiquoted Text r]
xs) = Antiquoted Text r
x forall a. a -> [a] -> [a]
: forall r. [Antiquoted Text r] -> [Antiquoted Text r]
mergePlain [Antiquoted Text r]
xs

-- | Remove 'Plain' values equal to 'mempty', as they don't have any
-- informational content.
removeEmptyPlains :: [Antiquoted Text r] -> [Antiquoted Text r]
removeEmptyPlains :: forall r. [Antiquoted Text r] -> [Antiquoted Text r]
removeEmptyPlains = forall a. (a -> Bool) -> [a] -> [a]
filter forall {a} {r}. (Eq a, Monoid a) => Antiquoted a r -> Bool
f where
  f :: Antiquoted a r -> Bool
f (Plain a
x) = a
x forall a. Eq a => a -> a -> Bool
/= forall a. Monoid a => a
mempty
  f Antiquoted a r
_         = Bool
True

  -- trimEnd xs
  --     | null xs = xs
  --     | otherwise = case last xs of
  --           Plain x -> init xs <> [Plain (T.dropWhileEnd (== ' ') x)]
  --           _ -> xs

-- | Equivalent to case splitting on 'Antiquoted' strings.
runAntiquoted :: v -> (v -> a) -> (r -> a) -> Antiquoted v r -> a
runAntiquoted :: forall v a r. v -> (v -> a) -> (r -> a) -> Antiquoted v r -> a
runAntiquoted v
_  v -> a
f r -> a
_ (Plain v
v)      = v -> a
f v
v
runAntiquoted v
nl v -> a
f r -> a
_ Antiquoted v r
EscapedNewline = v -> a
f v
nl
runAntiquoted v
_  v -> a
_ r -> a
k (Antiquoted r
r) = r -> a
k r
r

-- | Split a stream representing a string with antiquotes on line breaks.
splitLines :: forall r . [Antiquoted Text r] -> [[Antiquoted Text r]]
splitLines :: forall r. [Antiquoted Text r] -> [[Antiquoted Text r]]
splitLines = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (forall a b c. (a -> b -> c) -> b -> a -> c
flip (:)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Antiquoted Text r] -> ([[Antiquoted Text r]], [Antiquoted Text r])
go
 where
  go :: [Antiquoted Text r] -> ([[Antiquoted Text r]], [Antiquoted Text r])
  go :: [Antiquoted Text r] -> ([[Antiquoted Text r]], [Antiquoted Text r])
go (Plain Text
t : [Antiquoted Text r]
xs) = (forall x. One x => OneItem x -> x
one (forall v r. v -> Antiquoted v r
Plain Text
l) forall a. Semigroup a => a -> a -> a
<>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {b} {v} {r}.
Monoid b =>
v
-> ([[Antiquoted v r]], [Antiquoted v r])
-> ([[Antiquoted v r]], b)
f ([Antiquoted Text r] -> ([[Antiquoted Text r]], [Antiquoted Text r])
go [Antiquoted Text r]
xs) [Text]
ls
   where
    (Text
l : [Text]
ls) = (Char -> Bool) -> Text -> [Text]
T.split (forall a. Eq a => a -> a -> Bool
== Char
'\n') Text
t
    f :: v
-> ([[Antiquoted v r]], [Antiquoted v r])
-> ([[Antiquoted v r]], b)
f v
prefix ([[Antiquoted v r]]
finished, [Antiquoted v r]
current) = ((forall v r. v -> Antiquoted v r
Plain v
prefix forall a. a -> [a] -> [a]
: [Antiquoted v r]
current) forall a. a -> [a] -> [a]
: [[Antiquoted v r]]
finished, forall a. Monoid a => a
mempty)
  go (Antiquoted r
a   : [Antiquoted Text r]
xs) = (forall x. One x => OneItem x -> x
one (forall v r. r -> Antiquoted v r
Antiquoted r
a) forall a. Semigroup a => a -> a -> a
<>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Antiquoted Text r] -> ([[Antiquoted Text r]], [Antiquoted Text r])
go [Antiquoted Text r]
xs
  go (Antiquoted Text r
EscapedNewline : [Antiquoted Text r]
xs) = (forall x. One x => OneItem x -> x
one forall v r. Antiquoted v r
EscapedNewline forall a. Semigroup a => a -> a -> a
<>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Antiquoted Text r] -> ([[Antiquoted Text r]], [Antiquoted Text r])
go [Antiquoted Text r]
xs
  go []                    = forall a. Monoid a => a
mempty

-- | Join a stream of strings containing antiquotes again. This is the inverse
-- of 'splitLines'.
unsplitLines :: [[Antiquoted Text r]] -> [Antiquoted Text r]
unsplitLines :: forall r. [[Antiquoted Text r]] -> [Antiquoted Text r]
unsplitLines = forall a. [a] -> [[a]] -> [a]
intercalate forall a b. (a -> b) -> a -> b
$ forall x. One x => OneItem x -> x
one forall a b. (a -> b) -> a -> b
$ forall v r. v -> Antiquoted v r
Plain Text
"\n"

-- | Form an indented string by stripping spaces equal to the minimal indent.
stripIndent :: [Antiquoted Text r] -> NString r
stripIndent :: forall r. [Antiquoted Text r] -> NString r
stripIndent [] = forall r. Int -> [Antiquoted Text r] -> NString r
Indented Int
0 forall a. Monoid a => a
mempty
stripIndent [Antiquoted Text r]
xs =
  forall r. Int -> [Antiquoted Text r] -> NString r
Indented
    Int
minIndent
    (forall r. [Antiquoted Text r] -> [Antiquoted Text r]
removeEmptyPlains forall a b. (a -> b) -> a -> b
$
      forall r. [Antiquoted Text r] -> [Antiquoted Text r]
mergePlain forall a b. (a -> b) -> a -> b
$
        (forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) forall a b. (a -> b) -> a -> b
$
          forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd
            forall {r} {r}.
(Maybe (Antiquoted Text r), Antiquoted Text r) -> Bool
cleanup
            forall a b. (a -> b) -> a -> b
$ forall {b}. [b] -> [(Maybe b, b)]
pairWithLast forall a b. (a -> b) -> a -> b
$ forall r. [[Antiquoted Text r]] -> [Antiquoted Text r]
unsplitLines [[Antiquoted Text r]]
ls'
    )
 where
  pairWithLast :: [b] -> [(Maybe b, b)]
pairWithLast [b]
ys =
    forall a b. [a] -> [b] -> [(a, b)]
zip
      (forall (t :: * -> *) b a. Foldable t => b -> (t a -> b) -> t a -> b
handlePresence
        forall a. Maybe a
Nothing
        (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> a
Unsafe.last)
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. [a] -> [[a]]
inits [b]
ys
      )
      [b]
ys

  ls :: [[Antiquoted Text r]]
ls        = forall {r}. [[Antiquoted Text r]] -> [[Antiquoted Text r]]
stripEmptyOpening forall a b. (a -> b) -> a -> b
$ forall r. [Antiquoted Text r] -> [[Antiquoted Text r]]
splitLines [Antiquoted Text r]
xs
  ls' :: [[Antiquoted Text r]]
ls'       = forall {r}. Int -> [Antiquoted Text r] -> [Antiquoted Text r]
dropSpaces Int
minIndent forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Antiquoted Text r]]
ls

  minIndent :: Int
minIndent =
    forall (t :: * -> *) b a. Foldable t => b -> (t a -> b) -> t a -> b
handlePresence
      Int
0
      (forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall {r}. [Antiquoted Text r] -> Int
countSpaces forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r. [Antiquoted Text r] -> [Antiquoted Text r]
mergePlain forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>))
      (forall {r}. [[Antiquoted Text r]] -> [[Antiquoted Text r]]
stripEmptyLines [[Antiquoted Text r]]
ls)

  stripEmptyLines :: [[Antiquoted Text r]] -> [[Antiquoted Text r]]
stripEmptyLines = forall a. (a -> Bool) -> [a] -> [a]
filter forall a b. (a -> b) -> a -> b
$ \case
    [Plain Text
t] -> Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Text -> Bool
T.null forall a b. (a -> b) -> a -> b
$ Text -> Text
T.strip Text
t
    [Antiquoted Text r]
_         -> Bool
True

  stripEmptyOpening :: [[Antiquoted Text r]] -> [[Antiquoted Text r]]
stripEmptyOpening ([Plain Text
t] : [[Antiquoted Text r]]
ts) | Text -> Bool
T.null (Text -> Text
T.strip Text
t) = [[Antiquoted Text r]]
ts
  stripEmptyOpening [[Antiquoted Text r]]
ts = [[Antiquoted Text r]]
ts

  countSpaces :: [Antiquoted Text r] -> Int
countSpaces (Antiquoted r
_   : [Antiquoted Text r]
_) = Int
0
  countSpaces (Antiquoted Text r
EscapedNewline : [Antiquoted Text r]
_) = Int
0
  countSpaces (Plain Text
t        : [Antiquoted Text r]
_) = Text -> Int
T.length forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
T.takeWhile (forall a. Eq a => a -> a -> Bool
== Char
' ') forall a b. (a -> b) -> a -> b
$ Text
t
  countSpaces []                   = Int
0

  dropSpaces :: Int -> [Antiquoted Text r] -> [Antiquoted Text r]
dropSpaces Int
0 [Antiquoted Text r]
x              = [Antiquoted Text r]
x
  dropSpaces Int
n (Plain Text
t : [Antiquoted Text r]
cs) = forall v r. v -> Antiquoted v r
Plain (Int -> Text -> Text
T.drop Int
n Text
t) forall a. a -> [a] -> [a]
: [Antiquoted Text r]
cs
  dropSpaces Int
_ [Antiquoted Text r]
_              = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"stripIndent: impossible"

  cleanup :: (Maybe (Antiquoted Text r), Antiquoted Text r) -> Bool
cleanup (Maybe (Antiquoted Text r)
Nothing, Plain Text
y) = (Char -> Bool) -> Text -> Bool
T.all (forall a. Eq a => a -> a -> Bool
== Char
' ') Text
y
  cleanup (Just (Plain Text
x), Plain Text
y) | Text
"\n" Text -> Text -> Bool
`T.isSuffixOf` Text
x = (Char -> Bool) -> Text -> Bool
T.all (forall a. Eq a => a -> a -> Bool
== Char
' ') Text
y
  cleanup (Maybe (Antiquoted Text r), Antiquoted Text r)
_                  = Bool
False

escapeCodes :: [(Char, Char)]
escapeCodes :: [(Char, Char)]
escapeCodes =
  [(Char
'\n', Char
'n'), (Char
'\r', Char
'r'), (Char
'\t', Char
't'), (Char
'"', Char
'"'), (Char
'$', Char
'$'), (Char
'\\', Char
'\\')]

fromEscapeCode :: Char -> Maybe Char
fromEscapeCode :: Char -> Maybe Char
fromEscapeCode = (forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup` (forall a b. (a, b) -> (b, a)
swap forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Char, Char)]
escapeCodes))

toEscapeCode :: Char -> Maybe Char
toEscapeCode :: Char -> Maybe Char
toEscapeCode = (forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup` [(Char, Char)]
escapeCodes)

escapeMap :: [(Text, Text)]
escapeMap :: [(Text, Text)]
escapeMap =
  [(Text
"\n", Text
"\\n"), (Text
"\r", Text
"\\r"), (Text
"\t", Text
"\\t"), (Text
"\"", Text
"\\\""), (Text
"${", Text
"\\${"), (Text
"\\", Text
"\\\\")]

escapeString :: Text -> Text
escapeString :: Text -> Text
escapeString = forall (t :: * -> *) a. Foldable t => t (a -> a) -> a -> a
applyAll (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> Text -> Text -> Text
T.replace) [(Text, Text)]
escapeMap)