{-# LANGUAGE QuasiQuotes     #-}
{-# LANGUAGE TemplateHaskell #-}
-- |
module Python.Internal.EvalQQ
  ( -- * Evaluators and QQ
    evaluatorPymain
  , evaluatorPy_
  , evaluatorPye
  , evaluatorPyf
    -- * Code generation
  , expQQ
  , Mode(..)
  ) where

import Control.Monad.IO.Class
import Control.Monad.Catch
import Data.Bits
import Data.Char
import Data.List                 (intercalate)
import Data.ByteString           qualified as BS
import Data.Text                 qualified as T
import Data.Text.Encoding        qualified as T
import Foreign.C.Types
import Foreign.Ptr
import System.Exit
import System.Process (readProcessWithExitCode)

import Language.C.Inline          qualified as C
import Language.C.Inline.Unsafe   qualified as CU
import Language.Haskell.TH.Lib    qualified as TH
import Language.Haskell.TH.Syntax qualified as TH

import Python.Internal.Types
import Python.Internal.Program
import Python.Internal.Eval
import Python.Internal.CAPI
import Python.Inline.Literal


----------------------------------------------------------------
C.context (C.baseCtx <> pyCtx)
C.include "<inline-python.h>"
----------------------------------------------------------------

----------------------------------------------------------------
-- Evaluators
----------------------------------------------------------------

-- | Evaluate expression within context of @__main__@ module. All
--   variables defined in this evaluator persist.
pyExecExpr
  :: Ptr PyObject -- ^ Globals
  -> Ptr PyObject -- ^ Locals
  -> String       -- ^ Python source code
  -> Py ()
pyExecExpr :: Ptr PyObject -> Ptr PyObject -> String -> Py ()
pyExecExpr Ptr PyObject
p_globals Ptr PyObject
p_locals String
src = Program () () -> Py ()
forall a. Program a a -> Py a
runProgram (Program () () -> Py ()) -> Program () () -> Py ()
forall a b. (a -> b) -> a -> b
$ do
  CString
p_py <- String -> Program () CString
forall r. String -> Program r CString
withPyCString String
src
  Py () -> Program () ()
forall a r. Py a -> Program r a
progPy (Py () -> Program () ()) -> Py () -> Program () ()
forall a b. (a -> b) -> a -> b
$ do
    IO () -> Py ()
forall a. IO a -> Py a
Py [C.block| void {
      PyObject* globals = $(PyObject* p_globals);
      PyObject* locals  = $(PyObject* p_locals);
      // Compile code
      PyObject *code = Py_CompileString($(char* p_py), "<interactive>", Py_file_input);
      if( PyErr_Occurred() ){
          return;
      }
      // Execute statements
      PyObject* res = PyEval_EvalCode(code, globals, locals);
      Py_XDECREF(res);
      Py_DECREF(code);
      } |]
    Py ()
checkThrowPyError

-- | Evaluate expression with fresh local environment
pyEvalExpr
  :: Ptr PyObject -- ^ Globals
  -> Ptr PyObject -- ^ Locals
  -> String       -- ^ Python source code
  -> Py PyObject
pyEvalExpr :: Ptr PyObject -> Ptr PyObject -> String -> Py PyObject
pyEvalExpr Ptr PyObject
p_globals Ptr PyObject
p_locals String
src = Program PyObject PyObject -> Py PyObject
forall a. Program a a -> Py a
runProgram (Program PyObject PyObject -> Py PyObject)
-> Program PyObject PyObject -> Py PyObject
forall a b. (a -> b) -> a -> b
$ do
  CString
p_py  <- String -> Program PyObject CString
forall r. String -> Program r CString
withPyCString String
src
  Py PyObject -> Program PyObject PyObject
forall a r. Py a -> Program r a
progPy (Py PyObject -> Program PyObject PyObject)
-> Py PyObject -> Program PyObject PyObject
forall a b. (a -> b) -> a -> b
$ do
    Ptr PyObject
p_res <- IO (Ptr PyObject) -> Py (Ptr PyObject)
forall a. IO a -> Py a
Py [C.block| PyObject* {
      PyObject* globals = $(PyObject* p_globals);
      PyObject* locals  = $(PyObject* p_locals);
      // Compile code
      PyObject *code = Py_CompileString($(char* p_py), "<interactive>", Py_eval_input);
      if( PyErr_Occurred() ) {
          return NULL;
      }
      // Evaluate expression
      PyObject* r = PyEval_EvalCode(code, globals, locals);
      Py_DECREF(code);
      return r;
      }|]
    Py ()
checkThrowPyError
    Ptr PyObject -> Py PyObject
newPyObject Ptr PyObject
p_res


evaluatorPymain :: (Ptr PyObject -> Py String) -> Py ()
evaluatorPymain :: (Ptr PyObject -> Py String) -> Py ()
evaluatorPymain Ptr PyObject -> Py String
getSource = do
  Ptr PyObject
p_main <- Py (Ptr PyObject)
basicMainDict
  String
src    <- Ptr PyObject -> Py String
getSource Ptr PyObject
p_main
  Ptr PyObject -> Ptr PyObject -> String -> Py ()
pyExecExpr Ptr PyObject
p_main Ptr PyObject
p_main String
src

evaluatorPy_ :: (Ptr PyObject -> Py String) -> Py ()
evaluatorPy_ :: (Ptr PyObject -> Py String) -> Py ()
evaluatorPy_ Ptr PyObject -> Py String
getSource = Program () () -> Py ()
forall a. Program a a -> Py a
runProgram (Program () () -> Py ()) -> Program () () -> Py ()
forall a b. (a -> b) -> a -> b
$ do
  Ptr PyObject
p_globals <- Py (Ptr PyObject) -> Program () (Ptr PyObject)
forall a r. Py a -> Program r a
progPy Py (Ptr PyObject)
basicMainDict
  Ptr PyObject
p_locals  <- Ptr PyObject -> Program () (Ptr PyObject)
forall r. Ptr PyObject -> Program r (Ptr PyObject)
takeOwnership (Ptr PyObject -> Program () (Ptr PyObject))
-> Program () (Ptr PyObject) -> Program () (Ptr PyObject)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Py (Ptr PyObject) -> Program () (Ptr PyObject)
forall a r. Py a -> Program r a
progPy Py (Ptr PyObject)
basicNewDict
  Py () -> Program () ()
forall a r. Py a -> Program r a
progPy (Py () -> Program () ()) -> Py () -> Program () ()
forall a b. (a -> b) -> a -> b
$ Ptr PyObject -> Ptr PyObject -> String -> Py ()
pyExecExpr Ptr PyObject
p_globals Ptr PyObject
p_locals (String -> Py ()) -> Py String -> Py ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr PyObject -> Py String
getSource Ptr PyObject
p_locals

evaluatorPye :: (Ptr PyObject -> Py String) -> Py PyObject
evaluatorPye :: (Ptr PyObject -> Py String) -> Py PyObject
evaluatorPye Ptr PyObject -> Py String
getSource = Program PyObject PyObject -> Py PyObject
forall a. Program a a -> Py a
runProgram (Program PyObject PyObject -> Py PyObject)
-> Program PyObject PyObject -> Py PyObject
forall a b. (a -> b) -> a -> b
$ do
  Ptr PyObject
p_globals <- Py (Ptr PyObject) -> Program PyObject (Ptr PyObject)
forall a r. Py a -> Program r a
progPy Py (Ptr PyObject)
basicMainDict
  Ptr PyObject
p_locals  <- Ptr PyObject -> Program PyObject (Ptr PyObject)
forall r. Ptr PyObject -> Program r (Ptr PyObject)
takeOwnership (Ptr PyObject -> Program PyObject (Ptr PyObject))
-> Program PyObject (Ptr PyObject)
-> Program PyObject (Ptr PyObject)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Py (Ptr PyObject) -> Program PyObject (Ptr PyObject)
forall a r. Py a -> Program r a
progPy Py (Ptr PyObject)
basicNewDict
  Py PyObject -> Program PyObject PyObject
forall a r. Py a -> Program r a
progPy (Py PyObject -> Program PyObject PyObject)
-> Py PyObject -> Program PyObject PyObject
forall a b. (a -> b) -> a -> b
$ Ptr PyObject -> Ptr PyObject -> String -> Py PyObject
pyEvalExpr Ptr PyObject
p_globals Ptr PyObject
p_locals (String -> Py PyObject) -> Py String -> Py PyObject
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr PyObject -> Py String
getSource Ptr PyObject
p_locals

evaluatorPyf :: (Ptr PyObject -> Py String) -> Py PyObject
evaluatorPyf :: (Ptr PyObject -> Py String) -> Py PyObject
evaluatorPyf Ptr PyObject -> Py String
getSource = Program PyObject PyObject -> Py PyObject
forall a. Program a a -> Py a
runProgram (Program PyObject PyObject -> Py PyObject)
-> Program PyObject PyObject -> Py PyObject
forall a b. (a -> b) -> a -> b
$ do
  Ptr PyObject
p_globals <- Py (Ptr PyObject) -> Program PyObject (Ptr PyObject)
forall a r. Py a -> Program r a
progPy Py (Ptr PyObject)
basicMainDict
  Ptr PyObject
p_locals  <- Ptr PyObject -> Program PyObject (Ptr PyObject)
forall r. Ptr PyObject -> Program r (Ptr PyObject)
takeOwnership (Ptr PyObject -> Program PyObject (Ptr PyObject))
-> Program PyObject (Ptr PyObject)
-> Program PyObject (Ptr PyObject)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Py (Ptr PyObject) -> Program PyObject (Ptr PyObject)
forall a r. Py a -> Program r a
progPy Py (Ptr PyObject)
basicNewDict
  Ptr PyObject
p_kwargs  <- Ptr PyObject -> Program PyObject (Ptr PyObject)
forall r. Ptr PyObject -> Program r (Ptr PyObject)
takeOwnership (Ptr PyObject -> Program PyObject (Ptr PyObject))
-> Program PyObject (Ptr PyObject)
-> Program PyObject (Ptr PyObject)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Py (Ptr PyObject) -> Program PyObject (Ptr PyObject)
forall a r. Py a -> Program r a
progPy Py (Ptr PyObject)
basicNewDict
  Py PyObject -> Program PyObject PyObject
forall a r. Py a -> Program r a
progPy (Py PyObject -> Program PyObject PyObject)
-> Py PyObject -> Program PyObject PyObject
forall a b. (a -> b) -> a -> b
$ do
    -- Create function in p_locals
    Ptr PyObject -> Ptr PyObject -> String -> Py ()
pyExecExpr Ptr PyObject
p_globals Ptr PyObject
p_locals (String -> Py ()) -> Py String -> Py ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr PyObject -> Py String
getSource Ptr PyObject
p_kwargs
    -- Look up function
    Ptr PyObject
p_fun <- Ptr PyObject -> Py (Ptr PyObject)
getFunctionObject Ptr PyObject
p_locals Py (Ptr PyObject)
-> (Ptr PyObject -> Py (Ptr PyObject)) -> Py (Ptr PyObject)
forall a b. Py a -> (a -> Py b) -> Py b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Ptr PyObject
NULL -> PyInternalError -> Py (Ptr PyObject)
forall e a. (HasCallStack, Exception e) => e -> Py a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM (PyInternalError -> Py (Ptr PyObject))
-> PyInternalError -> Py (Ptr PyObject)
forall a b. (a -> b) -> a -> b
$ String -> PyInternalError
PyInternalError String
"_inline_python_ must be present"
      Ptr PyObject
p    -> Ptr PyObject -> Py (Ptr PyObject)
forall a. a -> Py a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ptr PyObject
p
    -- Call python function we just constructed
    Ptr PyObject -> Py PyObject
newPyObject (Ptr PyObject -> Py PyObject) -> Py (Ptr PyObject) -> Py PyObject
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr PyObject -> Py (Ptr PyObject)
throwOnNULL (Ptr PyObject -> Py (Ptr PyObject))
-> Py (Ptr PyObject) -> Py (Ptr PyObject)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr PyObject -> Ptr PyObject -> Py (Ptr PyObject)
basicCallKwdOnly Ptr PyObject
p_fun Ptr PyObject
p_kwargs


basicBindInDict :: ToPy a => String -> a -> Ptr PyObject -> Py ()
basicBindInDict :: forall a. ToPy a => String -> a -> Ptr PyObject -> Py ()
basicBindInDict String
name a
a Ptr PyObject
p_dict = Program () () -> Py ()
forall a. Program a a -> Py a
runProgram (Program () () -> Py ()) -> Program () () -> Py ()
forall a b. (a -> b) -> a -> b
$ do
  CString
p_key <- String -> Program () CString
forall r. String -> Program r CString
withPyCString String
name
  Ptr PyObject
p_obj <- Ptr PyObject -> Program () (Ptr PyObject)
forall r. Ptr PyObject -> Program r (Ptr PyObject)
takeOwnership (Ptr PyObject -> Program () (Ptr PyObject))
-> Program () (Ptr PyObject) -> Program () (Ptr PyObject)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Py (Ptr PyObject) -> Program () (Ptr PyObject)
forall a r. Py a -> Program r a
progPy (Ptr PyObject -> Py (Ptr PyObject)
throwOnNULL (Ptr PyObject -> Py (Ptr PyObject))
-> Py (Ptr PyObject) -> Py (Ptr PyObject)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< a -> Py (Ptr PyObject)
forall a. ToPy a => a -> Py (Ptr PyObject)
basicToPy a
a)
  Py () -> Program () ()
forall a r. Py a -> Program r a
progPy (Py () -> Program () ()) -> Py () -> Program () ()
forall a b. (a -> b) -> a -> b
$ do
    CInt
r <- IO CInt -> Py CInt
forall a. IO a -> Py a
Py [C.block| int {
      PyObject* p_obj = $(PyObject* p_obj);
      return PyDict_SetItemString($(PyObject* p_dict), $(char* p_key), p_obj);
      } |]
    case CInt
r of
      CInt
0 -> () -> Py ()
forall a. a -> Py a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      CInt
_ -> Py ()
forall a. Py a
mustThrowPyError

-- | Return dict of @__main__@ module
basicMainDict :: Py (Ptr PyObject)
basicMainDict :: Py (Ptr PyObject)
basicMainDict = IO (Ptr PyObject) -> Py (Ptr PyObject)
forall a. IO a -> Py a
Py IO (Ptr PyObject)
[CU.block| PyObject* {
  PyObject* main_module = PyImport_AddModule("__main__");
  if( PyErr_Occurred() )
      return NULL;
  return PyModule_GetDict(main_module);
  }|]

getFunctionObject :: Ptr PyObject -> Py (Ptr PyObject)
getFunctionObject :: Ptr PyObject -> Py (Ptr PyObject)
getFunctionObject Ptr PyObject
p_dict = do
  IO (Ptr PyObject) -> Py (Ptr PyObject)
forall a. IO a -> Py a
Py [CU.exp| PyObject* { PyDict_GetItemString($(PyObject *p_dict), "_inline_python_") } |]



----------------------------------------------------------------
-- TH generator
----------------------------------------------------------------

script :: String
script :: String
script = $( do let path = "py/bound-vars.py"
               TH.addDependentFile path
               TH.lift =<< TH.runIO (readFile path)
          )

data Mode
  = Eval
  | Exec
  | Fun

-- | Generate TH splice which updates python environment dictionary
--   and returns python source code.
expQQ :: Mode   -- ^ Python evaluation mode: @exec@/@eval@
      -> String -- ^ Python source code
      -> TH.Q TH.Exp
expQQ :: Mode -> String -> Q Exp
expQQ Mode
mode String
qq_src = do
  -- We need to preprocess before passing it to python.
  let src :: String
src     = Mode -> String -> String
prepareSource       Mode
mode String
qq_src
      src_var :: String
src_var = Mode -> String -> String
prepareForVarLookup Mode
mode String
src
  [String]
antis  <- IO [String] -> Q [String]
forall a. IO a -> Q a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [String] -> Q [String]) -> IO [String] -> Q [String]
forall a b. (a -> b) -> a -> b
$ do
    -- We've embedded script into library and we need to pass source
    -- code of QQ to a script. It can contain whatever symbols so to
    -- be safe it's base16 encode. This encoding is very simple and we
    -- don't care much about efficiency here
    (ExitCode
code, String
stdout, String
stderr) <- String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode String
"python"
        [ String
"-"
        , case Mode
mode of Mode
Eval -> String
"eval"
                       Mode
Exec -> String
"exec"
                       Mode
Fun  -> String
"exec"
        ]
      (String -> IO (ExitCode, String, String))
-> String -> IO (ExitCode, String, String)
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines [ String
script
                , String
"decode_and_print('" String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
                  [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ [ Int -> Char
intToDigit (Int -> Char) -> Int -> Char
forall a b. (a -> b) -> a -> b
$ Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
w Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR` Int
4)
                           , Int -> Char
intToDigit (Int -> Char) -> Int -> Char
forall a b. (a -> b) -> a -> b
$ Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
w Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
15) ]
                         | Word8
w <- ByteString -> [Word8]
BS.unpack (ByteString -> [Word8]) -> ByteString -> [Word8]
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
T.encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
src_var
                         ]
                  String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"')"
                ]
    case ExitCode
code of
      ExitCode
ExitSuccess   -> [String] -> IO [String]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([String] -> IO [String]) -> [String] -> IO [String]
forall a b. (a -> b) -> a -> b
$ String -> [String]
words String
stdout
      ExitFailure{} -> String -> IO [String]
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
stderr
  let args :: [Q Exp]
args = [ [| basicBindInDict $(String -> Q Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => String -> m Exp
TH.lift String
nm) $(String -> Q Exp
forall (m :: * -> *). Quote m => String -> m Exp
TH.dyn (String -> String
chop String
nm)) |]
             | String
nm <- [String]
antis
             ]
      src_eval :: String
src_eval = Mode -> [String] -> String -> String
prepareForEval Mode
mode [String]
antis String
src
  --
  [| \p_dict -> do
        mapM_ ($ p_dict) $([Q Exp] -> Q Exp
forall (m :: * -> *). Quote m => [m Exp] -> m Exp
TH.listE [Q Exp]
args)
        pure $(String -> Q Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => String -> m Exp
TH.lift String
src_eval)
   |]


antiSuffix :: String
antiSuffix :: String
antiSuffix = String
"_hs"

-- | Chop antiquotation variable names to get the corresponding Haskell variable name.
chop :: String -> String
chop :: String -> String
chop String
name = Int -> String -> String
forall a. Int -> [a] -> [a]
take (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
name Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
antiSuffix) String
name


----------------------------------------------------------------
-- Python source code transform
----------------------------------------------------------------

prepareSource :: Mode -> String -> String
prepareSource :: Mode -> String -> String
prepareSource = \case
  Mode
Eval -> (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace
  Mode
Exec -> String -> String
unindent
  Mode
Fun  -> String -> String
unindent

prepareForVarLookup :: Mode -> String -> String
prepareForVarLookup :: Mode -> String -> String
prepareForVarLookup = \case
  Mode
Eval -> String -> String
forall a. a -> a
id
  Mode
Exec -> String -> String
forall a. a -> a
id
  Mode
Fun  -> (String
"def __dummy__():\n"++) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
indent

prepareForEval :: Mode -> [String] -> String -> String
prepareForEval :: Mode -> [String] -> String -> String
prepareForEval Mode
mode [String]
vars String
src = case Mode
mode of
  Mode
Eval -> String
src
  Mode
Exec -> String
src
  Mode
Fun  -> String
"def _inline_python_("String -> String -> String
forall a. Semigroup a => a -> a -> a
<>String
argsString -> String -> String
forall a. Semigroup a => a -> a -> a
<>String
"):\n"
    String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> String
indent String
src
  where
    args :: String
args = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"," [String]
vars

-- Python is indentation based and quasiquotes do not strip leading
-- space. We have to do that ourself
unindent :: String -> String
unindent :: String -> String
unindent String
py_src = case String -> [String]
lines String
py_src of
  []  -> String
""
  -- Strip all leading space for 1-line scripts
  [String
l] -> (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace String
l
  -- For multiline script we require that first line should be empty
  String
l:[String]
ls
    | (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace) String
l -> String -> String
forall a. HasCallStack => String -> a
error String
"First line of multiline quasiquote must be empty"
    -- FIXME: We break multiline strings here. Badly. We need proper python lexer
    -- FIXME: We probably should just forbid tabs
    | Bool
otherwise ->
      let non_empty :: [String]
non_empty = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace)) [String]
ls
          n :: Int
n         = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [ String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
' ') String
s) | String
s <- [String]
non_empty ]
      in [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
n (String -> String) -> [String] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
ls

indent :: String -> String
indent :: String -> String
indent = [String] -> String
unlines
       ([String] -> String) -> (String -> [String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
"    "++)
       ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines