{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Text.PrettyPrint.Avh4.Indent (Indent, tab, spaces, width) where

spacesInTab :: Word
spacesInTab :: Word
spacesInTab = Word
4

-- | `Indent` represents an indentation level,
-- and the operator `<>` can be used to combine two indentations side-by-side, accounting for the tab size.
--
-- Each `Indent` can be thought of as:
-- one or more TABs, followed by zero to three SPACEs.
--
-- Combining two indents can be thought of as
-- typing the first and then the second sequence of
-- TABs and SPACEs in a word processor.
--
-- For example:
--
--    [TAB] <> [TAB]     ==  [TAB][TAB]
--    [TAB] <> ...       ==  [TAB]...
--    [TAB] <> [TAB]...  ==  [TAB][TAB]...
--     <> ...            ==  ...
--    [TAB].. <> [TAB]   ==  [TAB][TAB]
--    .. <> .            ==  ...
--    .. <> ..           ==  [TAB]
newtype Indent
  = Indent [Word]
  deriving (NonEmpty Indent -> Indent
Indent -> Indent -> Indent
forall b. Integral b => b -> Indent -> Indent
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> Indent -> Indent
$cstimes :: forall b. Integral b => b -> Indent -> Indent
sconcat :: NonEmpty Indent -> Indent
$csconcat :: NonEmpty Indent -> Indent
<> :: Indent -> Indent -> Indent
$c<> :: Indent -> Indent -> Indent
Semigroup, Semigroup Indent
Indent
[Indent] -> Indent
Indent -> Indent -> Indent
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [Indent] -> Indent
$cmconcat :: [Indent] -> Indent
mappend :: Indent -> Indent -> Indent
$cmappend :: Indent -> Indent -> Indent
mempty :: Indent
$cmempty :: Indent
Monoid, Int -> Indent -> ShowS
[Indent] -> ShowS
Indent -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Indent] -> ShowS
$cshowList :: [Indent] -> ShowS
show :: Indent -> String
$cshow :: Indent -> String
showsPrec :: Int -> Indent -> ShowS
$cshowsPrec :: Int -> Indent -> ShowS
Show)

instance Eq Indent where
  Indent
a == :: Indent -> Indent -> Bool
== Indent
b =
    Indent -> Word
width' Indent
a forall a. Eq a => a -> a -> Bool
== Indent -> Word
width' Indent
b

tab :: Indent
tab :: Indent
tab = [Word] -> Indent
Indent [Word
spacesInTab]

spaces :: Word -> Indent
spaces :: Word -> Indent
spaces = [Word] -> Indent
Indent forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure

width :: Num n => Indent -> n
width :: forall n. Num n => Indent -> n
width = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. Indent -> Word
width'

width' :: Indent -> Word
width' :: Indent -> Word
width' (Indent [Word]
is) =
  forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Word -> Word -> Word
combine Word
0 [Word]
is

combine :: Word -> Word -> Word
combine :: Word -> Word -> Word
combine Word
pos Word
i =
  if Word
i forall a. Ord a => a -> a -> Bool
< Word
spacesInTab
    then -- The right side starts with spaces (and no TABs),
    -- so just add everything together.
      Word
pos forall a. Num a => a -> a -> a
+ Word
i
    else -- The right side starts with at least one TAB,
    -- so remove the trailing spaces from the left.
      Word
pos forall a. Num a => a -> a -> a
- (Word
pos forall a. Integral a => a -> a -> a
`mod` Word
spacesInTab) forall a. Num a => a -> a -> a
+ Word
i