content: {-# language DataKinds #-}
  {-# language GeneralizedNewtypeDeriving, MultiParamTypeClasses, BangPatterns #-}
  {-# language TypeFamilies #-}
  {-# language DeriveFunctor, DeriveFoldable, DeriveTraversable, DeriveGeneric #-}
  {-# language TemplateHaskell #-}
  {-# language InstanceSigs, ScopedTypeVariables, TypeApplications #-}
  
  {-|
  Module      : Language.Python.Syntax.Whitespace
  Copyright   : (C) CSIRO 2017-2019
  License     : BSD3
  Maintainer  : Isaac Elliott <isaace71295@gmail.com>
  Stability   : experimental
  Portability : non-portable
  -}
  
  module Language.Python.Syntax.Whitespace
    ( -- * Whitespace
      Newline(..)
    , Whitespace(..)
    , Blank(..)
    , HasTrailingWhitespace(..)
    , HasTrailingNewline(..)
      -- * Indentation
    , IndentLevel, getIndentLevel, indentLevel, absoluteIndentLevel
    , Indent(..), indentWhitespaces, indentIt, dedentIt
    , Indents(..), indentsValue, indentsAnn, subtractStart
    )
  where
  
  import Control.Lens.Iso (Iso', iso, from)
  import Control.Lens.Getter ((^.), view)
  import Control.Lens.Lens (Lens', lens)
  import Control.Lens.Setter ((.~))
  import Control.Lens.TH (makeLenses)
  import Control.Lens.Traversal (Traversal')
  import Data.Deriving (deriveEq1, deriveOrd1)
  import Data.Generics.Product.Typed (typed)
  import Data.Foldable (toList)
  import Data.Function ((&))
  import Data.FingerTree (FingerTree, Measured(..), fromList)
  import Data.List (stripPrefix)
  import Data.List.NonEmpty (NonEmpty(..))
  import Data.Monoid (Monoid, Endo(..), Dual(..))
  import Data.Semigroup (Semigroup, (<>))
  import GHC.Exts (IsList(..))
  import GHC.Generics (Generic)
  
  import qualified Data.List.NonEmpty as NonEmpty
  
  import Language.Python.Syntax.Ann
  import Language.Python.Syntax.Comment
  
  -- | A newline is either a carriage return, a line feed, or a carriage return
  -- followed by a line feed.
  data Newline = CR | LF | CRLF deriving (Eq, Ord, Show)
  
  -- | Whitespace is either a space, a tab, a newline that continues the
  -- logical line ('Continued'), a newline that ends the logical line ('Newline'),
  -- or a 'Comment'.
  --
  -- Despite not literally being whitespace, comments inside enclosed forms
  -- are treated as whitespace. See <https://docs.python.org/3.5/reference/lexical_analysis.html#implicit-line-joining>
  --
  -- Example and counterexample of comments as whitespace
  --
  -- @
  --( 1 +
  --  # here's a comment
  -- 2 +
  -- 3 # another comment
  --)
  -- @
  --
  -- @
  -- x = 5 + 5
  -- # this line is not considered whitespace
  -- y = x * 2
  -- @
  --
  -- @
  -- [ 1
  -- , 2 # I'm whitespace
  -- , 3
  -- # also whitespace
  -- ]
  -- @
  data Whitespace
    = Space
    | Tab
    | Continued Newline [Whitespace]
    | Newline Newline
    | Comment (Comment ())
    deriving (Eq, Ord, Show)
  
  -- | Every syntactic element contains the whitespace that immediately follows it.
  --
  -- This type class lets us access this trailing whitespace in many different
  -- types throughout hpython.
  class HasTrailingWhitespace s where
    trailingWhitespace :: Lens' s [Whitespace]
  
  instance HasTrailingWhitespace a => HasTrailingWhitespace (NonEmpty a) where
    trailingWhitespace =
      lens
        (view trailingWhitespace . NonEmpty.last)
        (\(x :| xs) ws ->
           case xs of
             [] -> (x & trailingWhitespace .~ ws) :| xs
             x' : xs' -> NonEmpty.cons x $ (x' :| xs') & trailingWhitespace .~ ws)
  
  -- | A statement-containing thing may have a trailing newline
  --
  -- Some forms /always/ have a trailing newline, which is why this class isn't just
  -- @trailingNewline :: 'Lens'' (s v a) ('Maybe' 'Newline')@
  class HasTrailingNewline (s :: [*] -> * -> *) where
    trailingNewline :: Traversal' (s v a) Newline
    setTrailingNewline :: s v a -> Newline -> s v a
  
  -- | Lines which are "blank", meaning that they contain, if anything, only
  -- whitespace and/or a comment.
  data Blank a
    = Blank
    { _blankAnn :: Ann a
    , _blankWhitespaces :: [Whitespace]
    , _blankComment :: Maybe (Comment a)
    } deriving (Eq, Show, Functor, Foldable, Traversable, Generic)
  
  instance HasAnn Blank where
    annot :: forall a. Lens' (Blank a) (Ann a)
    annot = typed @(Ann a)
  
  -- | Python has rules regarding the expansion of tabs into spaces and how to
  -- go about computing indentation after this is done.
  --
  -- See <https://docs.python.org/3.5/reference/lexical_analysis.html#indentation>
  --
  -- This data structure implements those rules as a monoid.
  newtype IndentLevel
    = IndentLevel
    { appIndentLevel
      :: Maybe Int -> Dual (Endo (Bool, Int))
    }
    deriving (Semigroup, Monoid)
  
  indentLevel :: Indent -> Int
  indentLevel = getIndentLevel . measure . unIndent
  
  getIndentLevel :: IndentLevel -> Int
  getIndentLevel il =
    snd $
    appEndo (getDual (appIndentLevel il Nothing)) (False, 0)
  
  absoluteIndentLevel :: Int -> Indent -> Int
  absoluteIndentLevel n il =
    snd $
    appEndo (getDual (appIndentLevel (measure $ unIndent il) $ Just n)) (False, 0)
  
  instance Measured IndentLevel Whitespace where
    measure e =
      IndentLevel $
      \absolute -> Dual . Endo $
      \(b, !i) ->
      case e of
        Space -> (b, if b then i else i+1)
        Tab -> (b, if b then i else maybe (i + 8 - rem i 8) (+i) absolute)
        Continued{} -> (True, i)
        Newline{} -> error "Newline does not have an IndentLevel"
        Comment{} -> error "Comment does not have an IndentLevel"
  
  newtype Indent
    = MkIndent
    { unIndent :: FingerTree IndentLevel Whitespace
    } deriving (Eq, Ord, Show, Semigroup, Monoid)
  
  instance IsList Indent where
    type Item Indent = Whitespace
    toList = view indentWhitespaces
    fromList = view $ from indentWhitespaces
  
  -- | Indent some indentation by a chunk
  indentIt :: [Whitespace] -> Indents a -> Indents a
  indentIt ws (Indents a b) = Indents (ws ^. from indentWhitespaces : a) b
  
  -- | Deent some indentation by a chunk
  dedentIt :: Indents a -> Indents a
  dedentIt i@(Indents [] _) = i
  dedentIt (Indents (_:b) c) = Indents b c
  
  -- | An 'Indent' is isomorphic to a list of 'Whitespace'
  indentWhitespaces :: Iso' Indent [Whitespace]
  indentWhitespaces =
    iso (Data.Foldable.toList . unIndent) (MkIndent . Data.FingerTree.fromList)
  
  -- | Subtract the first argument from the beginning of the second
  --
  -- Returns 'Nothing' if the first list is not a prefix of the second.
  subtractStart :: Indents a -> Indents a -> Maybe (Indents a)
  subtractStart (Indents a _) (Indents b c) = Indents <$> stripPrefix a b <*> pure c
  
  -- | A possibly annotated list of 'Indent's.
  data Indents a
    = Indents
    { _indentsValue :: [Indent]
    , _indentsAnn :: Ann a
    } deriving (Eq, Show, Functor, Foldable, Traversable, Generic)
  
  instance Semigroup a => Semigroup (Indents a) where
    Indents a b <> Indents c d = Indents (a <> c) (b <> d)
  
  instance HasAnn Indents where
    annot :: forall a. Lens' (Indents a) (Ann a)
    annot = typed @(Ann a)
  
  makeLenses ''Indents
  deriveEq1 ''Indents
  deriveOrd1 ''Indents
  