{-# language OverloadedStrings #-}

module Autolib.ToDoc.Dutch where

import Autolib.Multilingual.Doc
import Data.List (intersperse)

-- | output sequences in "dutch style"
-- i. e. wrapped lines start (instead of end) with separators.
dutch :: (Doc, Doc, Doc) -- ^ ( opening, separator, closing )
      -> [ Doc ] -- ^ input
      -> Doc
dutch :: (Doc, Doc, Doc) -> [Doc] -> Doc
dutch (Doc
op,Doc
sep,Doc
cl) [Doc]
xs = case [Doc]
xs of 
        [] -> Doc
op Doc -> Doc -> Doc
<+> Doc
cl
        [Doc]
_ -> let xs' :: [Doc]
xs' = [Doc] -> [Doc]
forall a. HasCallStack => [a] -> [a]
init [Doc]
xs [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [ [Doc] -> Doc
forall a. HasCallStack => [a] -> a
last [Doc]
xs Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
" " ] 
             in  [Doc] -> Doc
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Doc -> Doc -> Doc) -> [Doc] -> [Doc] -> [Doc]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Doc -> Doc -> Doc
(<+>) (Doc
op Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: Doc -> [Doc]
forall a. a -> [a]
repeat Doc
sep) [Doc]
xs' [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [ Doc
cl ]

named_dutch_record :: Doc -> [ Doc ] -> Doc
named_dutch_record :: Doc -> [Doc] -> Doc
named_dutch_record Doc
tag [Doc]
docs = Doc -> Doc
group (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
    Doc
tag Doc -> Doc -> Doc
</> ((Doc, Doc, Doc) -> [Doc] -> Doc
flowing_dutch ( Doc
"{", Doc
comma, Doc
"}" ) [Doc]
docs)

-- | Make dutch-style group. If we are right of current-indentation,
-- then start a new line, and indent. See discussion at
-- https://git.imn.htwk-leipzig.de/autotool/all0/-/issues/960
flowing_dutch :: (Doc, Doc, Doc) -> [Doc] -> Doc
flowing_dutch (Doc
op,Doc
sep,Doc
cl) [Doc]
xs = (Doc
skip Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> Doc
group (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ 
  case [Doc]
xs of 
        [] -> Doc
op Doc -> Doc -> Doc
<+> Doc
cl
        [Doc]
_  ->
          let -- last item gets trailing space,
              -- this is needed for one-line groups
              -- before the closing delimiter.
              xs' :: [Doc]
xs' = [Doc] -> [Doc]
forall a. HasCallStack => [a] -> [a]
init [Doc]
xs [Doc] -> [Doc] -> [Doc]
forall a. Semigroup a => a -> a -> a
<> [ [Doc] -> Doc
forall a. HasCallStack => [a] -> a
last [Doc]
xs Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
" " ]
          in  [Doc] -> Doc
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Doc -> Doc -> Doc) -> [Doc] -> [Doc] -> [Doc]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\ Doc
l Doc
r -> Doc
l Doc -> Doc -> Doc
</> Doc
r)
                             (Doc
op Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: Doc -> [Doc]
forall a. a -> [a]
repeat Doc
sep) [Doc]
xs'
                    [Doc] -> [Doc] -> [Doc]
forall a. Semigroup a => a -> a -> a
<> [ Doc
cl ]

dutch_tuple :: [ Doc ] -> Doc
dutch_tuple :: [Doc] -> Doc
dutch_tuple = (Doc, Doc, Doc) -> [Doc] -> Doc
flowing_dutch ( Doc
"(", Doc
comma, Doc
")" )    

dutch_list :: [ Doc ] -> Doc
dutch_list :: [Doc] -> Doc
dutch_list = (Doc, Doc, Doc) -> [Doc] -> Doc
flowing_dutch ( Doc
"[", Doc
comma, Doc
"]" )    

dutch_set  :: [ Doc ] -> Doc
dutch_set :: [Doc] -> Doc
dutch_set = (Doc, Doc, Doc) -> [Doc] -> Doc
flowing_dutch ( Doc
"{", Doc
comma, Doc
"}" )    

dutch_semi  :: [ Doc ] -> Doc
dutch_semi :: [Doc] -> Doc
dutch_semi = (Doc, Doc, Doc) -> [Doc] -> Doc
flowing_dutch ( Doc
"{", Doc
semi, Doc
"}" )    

-----------------------------------------------------------------------

sepBy :: Doc -> [ Doc ] -> Doc
sepBy :: Doc -> [Doc] -> Doc
sepBy Doc
s [Doc]
ds = [Doc] -> Doc
fsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
intersperse Doc
s [Doc]
ds

quoted :: Doc -> Doc
quoted :: Doc -> Doc
quoted Doc
d = Char -> Doc
forall {a}. IsString a => Char -> Type a
char Char
'`' Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
d Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Char -> Doc
forall {a}. IsString a => Char -> Type a
char Char
'\''

-- | put 'l' atop indented 'r',
-- unless 'l' is very short (one letter),
-- then put 'r' right of it.
(</>) :: Doc -> Doc -> Doc
Doc
l </> :: Doc -> Doc -> Doc
</> Doc
r = (Doc
l Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
" ") Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Integer -> Doc -> Doc
forall {a}. Integral a => a -> Doc -> Doc
nest Integer
2 Doc
r -- contains PP.skip