{-# LANGUAGE AllowAmbiguousTypes   #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE FlexibleContexts      #-}
-- | Renders alignment to text with alignment markers,
--   for debugging purposes.
module Render.Debug(render, renderInline) where

import Data.Text (Text)
import qualified Data.Text as T
import Prelude hiding(getLine)
import Optics.Core ( view, Field2(..))

import FindColumns ( alignPos, getCol, tableColumns )
import Alignment ( textContent, Align(..), Processed )
import Util ( safeTail )

-- | Insert element at a given index of the list.
insertAt       :: Show a => Int -> a -> [a] -> [a]
insertAt :: forall a. Show a => Int -> a -> [a] -> [a]
insertAt Int
i a
e [a]
ls = case Int -> a -> [a] -> Maybe [a]
forall a. Int -> a -> [a] -> Maybe [a]
maybeInsertAt Int
i a
e [a]
ls of
                    Maybe [a]
Nothing -> [Char] -> [a]
forall a. HasCallStack => [Char] -> a
error ([Char] -> [a]) -> [Char] -> [a]
forall a b. (a -> b) -> a -> b
$ [Char]
"Failed in insertAt " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Int -> [Char]
forall a. Show a => a -> [Char]
show Int
i [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> a -> [Char]
forall a. Show a => a -> [Char]
show a
e [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [a] -> [Char]
forall a. Show a => a -> [Char]
show [a]
ls
                    Just [a]
r  -> [a]
r

-- | Insert element at a given index of the list, or return error.
maybeInsertAt :: Int -> a -> [a] -> Maybe [a]
maybeInsertAt :: forall a. Int -> a -> [a] -> Maybe [a]
maybeInsertAt Int
0 a
e    [a]
ls  = [a] -> Maybe [a]
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([a] -> Maybe [a]) -> [a] -> Maybe [a]
forall a b. (a -> b) -> a -> b
$ a
ea -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ls
maybeInsertAt Int
i a
e (a
l:[a]
ls) = (a
la -> [a] -> [a]
forall a. a -> [a] -> [a]
:) ([a] -> [a]) -> Maybe [a] -> Maybe [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> a -> [a] -> Maybe [a]
forall a. Int -> a -> [a] -> Maybe [a]
maybeInsertAt (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) a
e [a]
ls
maybeInsertAt Int
_ a
_    []  = Maybe [a]
forall a. Maybe a
Nothing

-- | Render text of code blocks
--   with marker columns inserted
--   to indicate alignment boundaries.
render :: [Processed] -> Text
render :: [Processed] -> Text
render [Processed]
ps = [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ [Processed] -> [Text]
forall {s}.
(Field3 s s Text Text,
 Field5 s s (Maybe (Align, Int)) (Maybe (Align, Int)),
 Field2 s s MyLoc MyLoc) =>
[s] -> [Text]
go [Processed]
ps
  where
    -- | Table columns between starting point of this segment and the next.
    lastColumn :: Int
lastColumn  = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Int]
tColumns Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
    -- | Translates indices of alignment/table columns to text columns.
    tColumns :: [Int]
    tColumns :: [Int]
tColumns = (Int, Maybe (Align, Int)) -> Int
forall a b. (a, b) -> a
fst ((Int, Maybe (Align, Int)) -> Int)
-> [(Int, Maybe (Align, Int))] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Processed] -> [(Int, Maybe (Align, Int))]
forall a b.
(Field2 a a MyLoc MyLoc, Field5 a a (Maybe b) (Maybe b)) =>
[a] -> [(Int, Maybe b)]
tableColumns [Processed]
ps
    go :: [s] -> [Text]
go  []        = []
    go (s
tok:[s]
toks) = Text
alignMarkerText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Int] -> Int -> s -> Text
forall {s}.
(Field3 s s Text Text,
 Field5 s s (Maybe (Align, Int)) (Maybe (Align, Int)),
 Field2 s s MyLoc MyLoc) =>
[Int] -> Int -> s -> Text
textWithMarkers [Int]
tColumns Int
nextCol s
tok
                               Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[s] -> [Text]
go [s]
toks
      where
        nextCol :: Int
nextCol = case [s]
toks of
                    []       -> Int
lastColumn
                    (s
next:[s]
_) -> s -> Int
forall a. Field2 a a MyLoc MyLoc => a -> Int
getCol s
next
        alignMarker :: Text
        alignMarker :: Text
alignMarker  = case Optic' A_Lens NoIx s (Maybe (Align, Int))
-> s -> Maybe (Align, Int)
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx s (Maybe (Align, Int))
forall a.
Field5 a a (Maybe (Align, Int)) (Maybe (Align, Int)) =>
Lens' a (Maybe (Align, Int))
alignPos s
tok of
                         Just (Align
ACenter, Int
_) -> Text
"^"
                         Just (Align, Int)
_            -> Text
"|"
                         Maybe (Align, Int)
_                 -> Text
""

-- | Text content with markers for markers inside it.
textWithMarkers :: [Int] -> Int -> s -> Text
textWithMarkers [Int]
tColumns Int
nextCol s
tok = 
    [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Int] -> [Char] -> [Char]
insertMarkers [Int]
unaccountedMarkers ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack (Text -> [Char]) -> Text -> [Char]
forall a b. (a -> b) -> a -> b
$ Optic' A_Lens NoIx s Text -> s -> Text
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx s Text
forall a. Field3 a a Text Text => Lens' a Text
textContent s
tok
  where
    insertMarkers :: [Int] -> [Char] -> [Char]
insertMarkers []   [Char]
txt = [Char]
txt
    insertMarkers [Int]
mrks [Char]
txt = (Int -> [Char] -> [Char]) -> [Char] -> [Int] -> [Char]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Int -> [Char] -> [Char]
insertMarker [Char]
txt [Int]
mrks

    insertMarker :: Int -> [Char] -> [Char]
insertMarker Int
index = Int -> Char -> [Char] -> [Char]
forall a. Show a => Int -> a -> [a] -> [a]
insertAt Int
index Char
'.'
    unaccountedMarkers :: [Int]
unaccountedMarkers = (Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (-s -> Int
forall a. Field2 a a MyLoc MyLoc => a -> Int
getCol s
tokInt -> Int -> Int
forall a. Num a => a -> a -> a
+)
                       ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ [Int] -> [Int]
forall {a}. [a] -> [a]
withoutKnownMarker
                       ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ Int -> Int -> [Int]
columnsBetween (s -> Int
forall a. Field2 a a MyLoc MyLoc => a -> Int
getCol s
tok) Int
nextCol
    withoutKnownMarker :: [a] -> [a]
withoutKnownMarker | Just (Align, Int)
_ <- Optic' A_Lens NoIx s (Maybe (Align, Int))
-> s -> Maybe (Align, Int)
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx s (Maybe (Align, Int))
forall a.
Field5 a a (Maybe (Align, Int)) (Maybe (Align, Int)) =>
Lens' a (Maybe (Align, Int))
alignPos s
tok = [a] -> [a]
forall {a}. [a] -> [a]
safeTail
                       | Bool
otherwise                   = [a] -> [a]
forall a. a -> a
id
    columnsBetween :: Int -> Int -> [Int]
    columnsBetween :: Int -> Int -> [Int]
columnsBetween Int
colA Int
colB = (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Int
c -> Int
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
colA Bool -> Bool -> Bool
&& Int
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
colB) [Int]
tColumns

renderInline :: Field2 a a Text Text => [a] -> Text
renderInline :: forall a. Field2 a a Text Text => [a] -> Text
renderInline = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ([Text] -> Text) -> ([a] -> [Text]) -> [a] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Text) -> [a] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Optic' A_Lens NoIx a Text -> a -> Text
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx a Text
forall s t a b. Field2 s t a b => Lens s t a b
_2)