    {-# LANGUAGE DeriveGeneric     #-}
    {-# LANGUAGE OverloadedStrings #-}

    module Dhall.Syntax.Chunks
        ( Chunks(..)

          -- * Optics
        , chunkExprs

          -- * `Data.Text.Text` manipulation
        , toDoubleQuoted
        , longestSharedWhitespacePrefix
        , linesLiteral
        , unlinesLiteral
        ) where

    import                Data.List.NonEmpty (NonEmpty (..))
    import                Data.String        (IsString (..))
    import                Data.Text          (Text)
    import                Dhall.Src          (Src)
    import {-# SOURCE #-} Dhall.Syntax.Expr  (Expr)
    import                GHC.Generics       (Generic)

    import qualified Data.Foldable
    import qualified Data.List.NonEmpty as NonEmpty
    import qualified Data.Text

    -- | The body of an interpolated @Text@ literal
    data Chunks s a = Chunks [(Text, Expr s a)] Text
        deriving (forall x. Chunks s a -> Rep (Chunks s a) x)
    -> (forall x. Rep (Chunks s a) x -> Chunks s a)
    -> Generic (Chunks s a)
    forall x. Rep (Chunks s a) x -> Chunks s a
    forall x. Chunks s a -> Rep (Chunks s a) x
    forall a.
    (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
    forall s a x. Rep (Chunks s a) x -> Chunks s a
    forall s a x. Chunks s a -> Rep (Chunks s a) x
    $cfrom :: forall s a x. Chunks s a -> Rep (Chunks s a) x
    from :: forall x. Chunks s a -> Rep (Chunks s a) x
    $cto :: forall s a x. Rep (Chunks s a) x -> Chunks s a
    to :: forall x. Rep (Chunks s a) x -> Chunks s a
    Generic

    instance IsString (Chunks s a) where
        fromString :: String -> Chunks s a
    fromString String
    str = [(Text, Expr s a)] -> Text -> Chunks s a
    forall s a. [(Text, Expr s a)] -> Text -> Chunks s a
    Chunks [] (String -> Text
    forall a. IsString a => String -> a
    fromString String
    str)

    instance Semigroup (Chunks s a) where
        Chunks [(Text, Expr s a)]
    xysL Text
    zL <> :: Chunks s a -> Chunks s a -> Chunks s a
    <> Chunks         []    Text
    zR =
            [(Text, Expr s a)] -> Text -> Chunks s a
    forall s a. [(Text, Expr s a)] -> Text -> Chunks s a
    Chunks [(Text, Expr s a)]
    xysL (Text
    zL Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    zR)
        Chunks [(Text, Expr s a)]
    xysL Text
    zL <> Chunks ((Text
    x, Expr s a
    y):[(Text, Expr s a)]
    xysR) Text
    zR =
            [(Text, Expr s a)] -> Text -> Chunks s a
    forall s a. [(Text, Expr s a)] -> Text -> Chunks s a
    Chunks ([(Text, Expr s a)]
    xysL [(Text, Expr s a)] -> [(Text, Expr s a)] -> [(Text, Expr s a)]
    forall a. [a] -> [a] -> [a]
    ++ (Text
    zL Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    x, Expr s a
    y)(Text, Expr s a) -> [(Text, Expr s a)] -> [(Text, Expr s a)]
    forall a. a -> [a] -> [a]
    :[(Text, Expr s a)]
    xysR) Text
    zR

    instance Monoid (Chunks s a) where
        mempty :: Chunks s a
    mempty = [(Text, Expr s a)] -> Text -> Chunks s a
    forall s a. [(Text, Expr s a)] -> Text -> Chunks s a
    Chunks [] Text
    forall a. Monoid a => a
    mempty

    -- | A traversal over the immediate sub-expressions in 'Chunks'.
    chunkExprs
      :: Applicative f
      => (Expr s a -> f (Expr t b))
      -> Chunks s a -> f (Chunks t b)
    chunkExprs :: forall (f :: * -> *) s a t b.
    Applicative f =>
    (Expr s a -> f (Expr t b)) -> Chunks s a -> f (Chunks t b)
    chunkExprs Expr s a -> f (Expr t b)
    f (Chunks [(Text, Expr s a)]
    chunks Text
    final) =
      ([(Text, Expr t b)] -> Text -> Chunks t b)
    -> Text -> [(Text, Expr t b)] -> Chunks t b
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip [(Text, Expr t b)] -> Text -> Chunks t b
    forall s a. [(Text, Expr s a)] -> Text -> Chunks s a
    Chunks Text
    final ([(Text, Expr t b)] -> Chunks t b)
    -> f [(Text, Expr t b)] -> f (Chunks t b)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ((Text, Expr s a) -> f (Text, Expr t b))
    -> [(Text, Expr s a)] -> f [(Text, Expr t b)]
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> [a] -> f [b]
    traverse ((Expr s a -> f (Expr t b))
    -> (Text, Expr s a) -> f (Text, Expr t b)
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> (Text, a) -> f (Text, b)
    traverse Expr s a -> f (Expr t b)
    f) [(Text, Expr s a)]
    chunks
    {-# INLINABLE chunkExprs #-}

    -- | Same as @Data.Text.splitOn@, except always returning a `NonEmpty` result
    splitOn :: Text -> Text -> NonEmpty Text
    splitOn :: Text -> Text -> NonEmpty Text
    splitOn Text
    needle Text
    haystack =
        case HasCallStack => Text -> Text -> [Text]
    Text -> Text -> [Text]
    Data.Text.splitOn Text
    needle Text
    haystack of
            []     -> Text
    "" Text -> [Text] -> NonEmpty Text
    forall a. a -> [a] -> NonEmpty a
    :| []
            Text
    t : [Text]
    ts -> Text
    t  Text -> [Text] -> NonEmpty Text
    forall a. a -> [a] -> NonEmpty a
    :| [Text]
    ts

    -- | Split `Chunks` by lines
    linesLiteral :: Chunks s a -> NonEmpty (Chunks s a)
    linesLiteral :: forall s a. Chunks s a -> NonEmpty (Chunks s a)
    linesLiteral (Chunks [] Text
    suffix) =
        (Text -> Chunks s a) -> NonEmpty Text -> NonEmpty (Chunks s a)
    forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ([(Text, Expr s a)] -> Text -> Chunks s a
    forall s a. [(Text, Expr s a)] -> Text -> Chunks s a
    Chunks []) (Text -> Text -> NonEmpty Text
    splitOn Text
    "\n" Text
    suffix)
    linesLiteral (Chunks ((Text
    prefix, Expr s a
    interpolation) : [(Text, Expr s a)]
    pairs₀) Text
    suffix₀) =
        (Chunks s a -> NonEmpty (Chunks s a) -> NonEmpty (Chunks s a))
    -> NonEmpty (Chunks s a) -> [Chunks s a] -> NonEmpty (Chunks s a)
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr
            Chunks s a -> NonEmpty (Chunks s a) -> NonEmpty (Chunks s a)
    forall a. a -> NonEmpty a -> NonEmpty a
    NonEmpty.cons
            ([(Text, Expr s a)] -> Text -> Chunks s a
    forall s a. [(Text, Expr s a)] -> Text -> Chunks s a
    Chunks ((Text
    lastLine, Expr s a
    interpolation) (Text, Expr s a) -> [(Text, Expr s a)] -> [(Text, Expr s a)]
    forall a. a -> [a] -> [a]
    : [(Text, Expr s a)]
    pairs₁) Text
    suffix₁ Chunks s a -> [Chunks s a] -> NonEmpty (Chunks s a)
    forall a. a -> [a] -> NonEmpty a
    :| [Chunks s a]
    chunks)
            ((Text -> Chunks s a) -> [Text] -> [Chunks s a]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ([(Text, Expr s a)] -> Text -> Chunks s a
    forall s a. [(Text, Expr s a)] -> Text -> Chunks s a
    Chunks []) [Text]
    initLines)
      where
        splitLines :: NonEmpty Text
    splitLines = Text -> Text -> NonEmpty Text
    splitOn Text
    "\n" Text
    prefix

        initLines :: [Text]
    initLines = NonEmpty Text -> [Text]
    forall a. NonEmpty a -> [a]
    NonEmpty.init NonEmpty Text
    splitLines
        lastLine :: Text
    lastLine  = NonEmpty Text -> Text
    forall a. NonEmpty a -> a
    NonEmpty.last NonEmpty Text
    splitLines

        Chunks [(Text, Expr s a)]
    pairs₁ Text
    suffix₁ :| [Chunks s a]
    chunks = Chunks s a -> NonEmpty (Chunks s a)
    forall s a. Chunks s a -> NonEmpty (Chunks s a)
    linesLiteral ([(Text, Expr s a)] -> Text -> Chunks s a
    forall s a. [(Text, Expr s a)] -> Text -> Chunks s a
    Chunks [(Text, Expr s a)]
    pairs₀ Text
    suffix₀)

    -- | Flatten several `Chunks` back into a single `Chunks` by inserting newlines
    unlinesLiteral :: NonEmpty (Chunks s a) -> Chunks s a
    unlinesLiteral :: forall s a. NonEmpty (Chunks s a) -> Chunks s a
    unlinesLiteral NonEmpty (Chunks s a)
    chunks =
        NonEmpty (Chunks s a) -> Chunks s a
    forall m. Monoid m => NonEmpty m -> m
    forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
    Data.Foldable.fold (Chunks s a -> NonEmpty (Chunks s a) -> NonEmpty (Chunks s a)
    forall a. a -> NonEmpty a -> NonEmpty a
    NonEmpty.intersperse Chunks s a
    "\n" NonEmpty (Chunks s a)
    chunks)

    -- | Returns `True` if the `Chunks` represents a blank line
    emptyLine :: Chunks s a -> Bool
    emptyLine :: forall s a. Chunks s a -> Bool
    emptyLine (Chunks [] Text
    ""  ) = Bool
    True
    emptyLine (Chunks [] Text
    "\r") = Bool
    True  -- So that `\r\n` is treated as a blank line
    emptyLine  Chunks s a
    _               = Bool
    False

    -- | Return the leading whitespace for a `Chunks` literal
    leadingSpaces :: Chunks s a -> Text
    leadingSpaces :: forall s a. Chunks s a -> Text
    leadingSpaces Chunks s a
    chunks = (Char -> Bool) -> Text -> Text
    Data.Text.takeWhile Char -> Bool
    isSpace Text
    firstText
      where
        isSpace :: Char -> Bool
    isSpace Char
    c = Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    ' ' Bool -> Bool -> Bool
    || Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '\t'

        firstText :: Text
    firstText =
            case Chunks s a
    chunks of
                Chunks                []  Text
    suffix -> Text
    suffix
                Chunks ((Text
    prefix, Expr s a
    _) : [(Text, Expr s a)]
    _ ) Text
    _      -> Text
    prefix

    {-| Compute the longest shared whitespace prefix for the purposes of stripping
        leading indentation
    -}
    longestSharedWhitespacePrefix :: NonEmpty (Chunks s a) -> Text
    longestSharedWhitespacePrefix :: forall s a. NonEmpty (Chunks s a) -> Text
    longestSharedWhitespacePrefix NonEmpty (Chunks s a)
    literals =
        case (Chunks s a -> Text) -> [Chunks s a] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Chunks s a -> Text
    forall s a. Chunks s a -> Text
    leadingSpaces [Chunks s a]
    filteredLines of
            Text
    l : [Text]
    ls -> (Text -> Text -> Text) -> Text -> [Text] -> Text
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    Data.Foldable.foldl' Text -> Text -> Text
    sharedPrefix Text
    l [Text]
    ls
            []     -> Text
    ""
      where
        sharedPrefix :: Text -> Text -> Text
    sharedPrefix Text
    ab Text
    ac =
            case Text -> Text -> Maybe (Text, Text, Text)
    Data.Text.commonPrefixes Text
    ab Text
    ac of
                Just (Text
    a, Text
    _b, Text
    _c) -> Text
    a
                Maybe (Text, Text, Text)
    Nothing          -> Text
    ""

        -- The standard specifies to filter out blank lines for all lines *except*
        -- for the last line
        filteredLines :: [Chunks s a]
    filteredLines = [Chunks s a]
    newInit [Chunks s a] -> [Chunks s a] -> [Chunks s a]
    forall a. Semigroup a => a -> a -> a
    <> Chunks s a -> [Chunks s a]
    forall a. a -> [a]
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Chunks s a
    oldLast
          where
            oldInit :: [Chunks s a]
    oldInit = NonEmpty (Chunks s a) -> [Chunks s a]
    forall a. NonEmpty a -> [a]
    NonEmpty.init NonEmpty (Chunks s a)
    literals

            oldLast :: Chunks s a
    oldLast = NonEmpty (Chunks s a) -> Chunks s a
    forall a. NonEmpty a -> a
    NonEmpty.last NonEmpty (Chunks s a)
    literals

            newInit :: [Chunks s a]
    newInit = (Chunks s a -> Bool) -> [Chunks s a] -> [Chunks s a]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool) -> (Chunks s a -> Bool) -> Chunks s a -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Chunks s a -> Bool
    forall s a. Chunks s a -> Bool
    emptyLine) [Chunks s a]
    oldInit

    -- | Drop the first @n@ characters for a `Chunks` literal
    dropLiteral :: Int -> Chunks s a -> Chunks s a
    dropLiteral :: forall s a. Int -> Chunks s a -> Chunks s a
    dropLiteral Int
    n (Chunks [] Text
    suffix) =
        [(Text, Expr s a)] -> Text -> Chunks s a
    forall s a. [(Text, Expr s a)] -> Text -> Chunks s a
    Chunks [] (Int -> Text -> Text
    Data.Text.drop Int
    n Text
    suffix)
    dropLiteral Int
    n (Chunks ((Text
    prefix, Expr s a
    interpolation) : [(Text, Expr s a)]
    rest) Text
    suffix) =
        [(Text, Expr s a)] -> Text -> Chunks s a
    forall s a. [(Text, Expr s a)] -> Text -> Chunks s a
    Chunks ((Int -> Text -> Text
    Data.Text.drop Int
    n Text
    prefix, Expr s a
    interpolation) (Text, Expr s a) -> [(Text, Expr s a)] -> [(Text, Expr s a)]
    forall a. a -> [a] -> [a]
    : [(Text, Expr s a)]
    rest) Text
    suffix

    {-| Convert a single-quoted `Chunks` literal to the equivalent double-quoted
        `Chunks` literal
    -}
    toDoubleQuoted :: Chunks Src a -> Chunks Src a
    toDoubleQuoted :: forall a. Chunks Src a -> Chunks Src a
    toDoubleQuoted Chunks Src a
    literal =
        NonEmpty (Chunks Src a) -> Chunks Src a
    forall s a. NonEmpty (Chunks s a) -> Chunks s a
    unlinesLiteral ((Chunks Src a -> Chunks Src a)
    -> NonEmpty (Chunks Src a) -> NonEmpty (Chunks Src a)
    forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Int -> Chunks Src a -> Chunks Src a
    forall s a. Int -> Chunks s a -> Chunks s a
    dropLiteral Int
    indent) NonEmpty (Chunks Src a)
    literals)
      where
        literals :: NonEmpty (Chunks Src a)
    literals = Chunks Src a -> NonEmpty (Chunks Src a)
    forall s a. Chunks s a -> NonEmpty (Chunks s a)
    linesLiteral Chunks Src a
    literal

        longestSharedPrefix :: Text
    longestSharedPrefix = NonEmpty (Chunks Src a) -> Text
    forall s a. NonEmpty (Chunks s a) -> Text
    longestSharedWhitespacePrefix NonEmpty (Chunks Src a)
    literals

        indent :: Int
    indent = Text -> Int
    Data.Text.length Text
    longestSharedPrefix