content: {-# 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 Generic
  
  instance IsString (Chunks s a) where
      fromString str = Chunks [] (fromString str)
  
  instance Semigroup (Chunks s a) where
      Chunks xysL zL <> Chunks         []    zR =
          Chunks xysL (zL <> zR)
      Chunks xysL zL <> Chunks ((x, y):xysR) zR =
          Chunks (xysL ++ (zL <> x, y):xysR) zR
  
  instance Monoid (Chunks s a) where
      mempty = Chunks [] 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 f (Chunks chunks final) =
    flip Chunks final <$> traverse (traverse f) chunks
  {-# INLINABLE chunkExprs #-}
  
  -- | Same as @Data.Text.splitOn@, except always returning a `NonEmpty` result
  splitOn :: Text -> Text -> NonEmpty Text
  splitOn needle haystack =
      case Data.Text.splitOn needle haystack of
          []     -> "" :| []
          t : ts -> t  :| ts
  
  -- | Split `Chunks` by lines
  linesLiteral :: Chunks s a -> NonEmpty (Chunks s a)
  linesLiteral (Chunks [] suffix) =
      fmap (Chunks []) (splitOn "\n" suffix)
  linesLiteral (Chunks ((prefix, interpolation) : pairs₀) suffix₀) =
      foldr
          NonEmpty.cons
          (Chunks ((lastLine, interpolation) : pairs₁) suffix₁ :| chunks)
          (fmap (Chunks []) initLines)
    where
      splitLines = splitOn "\n" prefix
  
      initLines = NonEmpty.init splitLines
      lastLine  = NonEmpty.last splitLines
  
      Chunks pairs₁ suffix₁ :| chunks = linesLiteral (Chunks pairs₀ suffix₀)
  
  -- | Flatten several `Chunks` back into a single `Chunks` by inserting newlines
  unlinesLiteral :: NonEmpty (Chunks s a) -> Chunks s a
  unlinesLiteral chunks =
      Data.Foldable.fold (NonEmpty.intersperse "\n" chunks)
  
  -- | Returns `True` if the `Chunks` represents a blank line
  emptyLine :: Chunks s a -> Bool
  emptyLine (Chunks [] ""  ) = True
  emptyLine (Chunks [] "\r") = True  -- So that `\r\n` is treated as a blank line
  emptyLine  _               = False
  
  -- | Return the leading whitespace for a `Chunks` literal
  leadingSpaces :: Chunks s a -> Text
  leadingSpaces chunks = Data.Text.takeWhile isSpace firstText
    where
      isSpace c = c == ' ' || c == '\t'
  
      firstText =
          case chunks of
              Chunks                []  suffix -> suffix
              Chunks ((prefix, _) : _ ) _      -> prefix
  
  {-| Compute the longest shared whitespace prefix for the purposes of stripping
      leading indentation
  -}
  longestSharedWhitespacePrefix :: NonEmpty (Chunks s a) -> Text
  longestSharedWhitespacePrefix literals =
      case fmap leadingSpaces filteredLines of
          l : ls -> Data.Foldable.foldl' sharedPrefix l ls
          []     -> ""
    where
      sharedPrefix ab ac =
          case Data.Text.commonPrefixes ab ac of
              Just (a, _b, _c) -> a
              Nothing          -> ""
  
      -- The standard specifies to filter out blank lines for all lines *except*
      -- for the last line
      filteredLines = newInit <> pure oldLast
        where
          oldInit = NonEmpty.init literals
  
          oldLast = NonEmpty.last literals
  
          newInit = filter (not . emptyLine) oldInit
  
  -- | Drop the first @n@ characters for a `Chunks` literal
  dropLiteral :: Int -> Chunks s a -> Chunks s a
  dropLiteral n (Chunks [] suffix) =
      Chunks [] (Data.Text.drop n suffix)
  dropLiteral n (Chunks ((prefix, interpolation) : rest) suffix) =
      Chunks ((Data.Text.drop n prefix, interpolation) : rest) suffix
  
  {-| Convert a single-quoted `Chunks` literal to the equivalent double-quoted
      `Chunks` literal
  -}
  toDoubleQuoted :: Chunks Src a -> Chunks Src a
  toDoubleQuoted literal =
      unlinesLiteral (fmap (dropLiteral indent) literals)
    where
      literals = linesLiteral literal
  
      longestSharedPrefix = longestSharedWhitespacePrefix literals
  
      indent = Data.Text.length longestSharedPrefix
  