{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}

{-|
Module      : Text.Pretty.Simple.Internal.Printer
Copyright   : (c) Dennis Gosnell, 2016
License     : BSD-style (see LICENSE file)
Maintainer  : cdep.illabout@gmail.com
Stability   : experimental
Portability : POSIX

-}
module Text.Pretty.Simple.Internal.ExprToOutput
  where

#if __GLASGOW_HASKELL__ < 710
-- We don't need this import for GHC 7.10 as it exports all required functions
-- from Prelude
import Control.Applicative
#endif

import Control.Monad (when)
import Control.Monad.State (MonadState, evalState, gets, modify)
import Data.Data (Data)
import Data.Monoid ((<>))
import Data.List (intersperse)
import Data.Typeable (Typeable)
import GHC.Generics (Generic)

import Text.Pretty.Simple.Internal.Expr (CommaSeparated(..), Expr(..))
import Text.Pretty.Simple.Internal.Output
       (NestLevel(..), Output(..), OutputType(..), unNestLevel)

-- $setup
-- >>> :set -XOverloadedStrings
-- >>> import Control.Monad.State (State)
-- >>> :{
-- let test :: PrinterState -> State PrinterState [Output] -> [Output]
--     test initState state = evalState state initState
--     testInit :: State PrinterState [Output] -> [Output]
--     testInit = test initPrinterState
-- :}

-- | Newtype around 'Int' to represent a line number.  After a newline, the
-- 'LineNum' will increase by 1.
newtype LineNum = LineNum { LineNum -> Int
unLineNum :: Int }
  deriving (Typeable LineNum
Constr
DataType
Typeable LineNum =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> LineNum -> c LineNum)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c LineNum)
-> (LineNum -> Constr)
-> (LineNum -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c LineNum))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c LineNum))
-> ((forall b. Data b => b -> b) -> LineNum -> LineNum)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> LineNum -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> LineNum -> r)
-> (forall u. (forall d. Data d => d -> u) -> LineNum -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> LineNum -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> LineNum -> m LineNum)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> LineNum -> m LineNum)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> LineNum -> m LineNum)
-> Data LineNum
LineNum -> Constr
LineNum -> DataType
(forall b. Data b => b -> b) -> LineNum -> LineNum
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LineNum -> c LineNum
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LineNum
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> LineNum -> u
forall u. (forall d. Data d => d -> u) -> LineNum -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LineNum -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LineNum -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> LineNum -> m LineNum
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> LineNum -> m LineNum
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LineNum
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LineNum -> c LineNum
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c LineNum)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c LineNum)
$cLineNum :: Constr
$tLineNum :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> LineNum -> m LineNum
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> LineNum -> m LineNum
gmapMp :: (forall d. Data d => d -> m d) -> LineNum -> m LineNum
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> LineNum -> m LineNum
gmapM :: (forall d. Data d => d -> m d) -> LineNum -> m LineNum
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> LineNum -> m LineNum
gmapQi :: Int -> (forall d. Data d => d -> u) -> LineNum -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> LineNum -> u
gmapQ :: (forall d. Data d => d -> u) -> LineNum -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> LineNum -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LineNum -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LineNum -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LineNum -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LineNum -> r
gmapT :: (forall b. Data b => b -> b) -> LineNum -> LineNum
$cgmapT :: (forall b. Data b => b -> b) -> LineNum -> LineNum
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c LineNum)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c LineNum)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c LineNum)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c LineNum)
dataTypeOf :: LineNum -> DataType
$cdataTypeOf :: LineNum -> DataType
toConstr :: LineNum -> Constr
$ctoConstr :: LineNum -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LineNum
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LineNum
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LineNum -> c LineNum
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LineNum -> c LineNum
$cp1Data :: Typeable LineNum
Data, LineNum -> LineNum -> Bool
(LineNum -> LineNum -> Bool)
-> (LineNum -> LineNum -> Bool) -> Eq LineNum
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LineNum -> LineNum -> Bool
$c/= :: LineNum -> LineNum -> Bool
== :: LineNum -> LineNum -> Bool
$c== :: LineNum -> LineNum -> Bool
Eq, (forall x. LineNum -> Rep LineNum x)
-> (forall x. Rep LineNum x -> LineNum) -> Generic LineNum
forall x. Rep LineNum x -> LineNum
forall x. LineNum -> Rep LineNum x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LineNum x -> LineNum
$cfrom :: forall x. LineNum -> Rep LineNum x
Generic, Integer -> LineNum
LineNum -> LineNum
LineNum -> LineNum -> LineNum
(LineNum -> LineNum -> LineNum)
-> (LineNum -> LineNum -> LineNum)
-> (LineNum -> LineNum -> LineNum)
-> (LineNum -> LineNum)
-> (LineNum -> LineNum)
-> (LineNum -> LineNum)
-> (Integer -> LineNum)
-> Num LineNum
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> LineNum
$cfromInteger :: Integer -> LineNum
signum :: LineNum -> LineNum
$csignum :: LineNum -> LineNum
abs :: LineNum -> LineNum
$cabs :: LineNum -> LineNum
negate :: LineNum -> LineNum
$cnegate :: LineNum -> LineNum
* :: LineNum -> LineNum -> LineNum
$c* :: LineNum -> LineNum -> LineNum
- :: LineNum -> LineNum -> LineNum
$c- :: LineNum -> LineNum -> LineNum
+ :: LineNum -> LineNum -> LineNum
$c+ :: LineNum -> LineNum -> LineNum
Num, Eq LineNum
Eq LineNum =>
(LineNum -> LineNum -> Ordering)
-> (LineNum -> LineNum -> Bool)
-> (LineNum -> LineNum -> Bool)
-> (LineNum -> LineNum -> Bool)
-> (LineNum -> LineNum -> Bool)
-> (LineNum -> LineNum -> LineNum)
-> (LineNum -> LineNum -> LineNum)
-> Ord LineNum
LineNum -> LineNum -> Bool
LineNum -> LineNum -> Ordering
LineNum -> LineNum -> LineNum
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: LineNum -> LineNum -> LineNum
$cmin :: LineNum -> LineNum -> LineNum
max :: LineNum -> LineNum -> LineNum
$cmax :: LineNum -> LineNum -> LineNum
>= :: LineNum -> LineNum -> Bool
$c>= :: LineNum -> LineNum -> Bool
> :: LineNum -> LineNum -> Bool
$c> :: LineNum -> LineNum -> Bool
<= :: LineNum -> LineNum -> Bool
$c<= :: LineNum -> LineNum -> Bool
< :: LineNum -> LineNum -> Bool
$c< :: LineNum -> LineNum -> Bool
compare :: LineNum -> LineNum -> Ordering
$ccompare :: LineNum -> LineNum -> Ordering
$cp1Ord :: Eq LineNum
Ord, ReadPrec [LineNum]
ReadPrec LineNum
Int -> ReadS LineNum
ReadS [LineNum]
(Int -> ReadS LineNum)
-> ReadS [LineNum]
-> ReadPrec LineNum
-> ReadPrec [LineNum]
-> Read LineNum
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [LineNum]
$creadListPrec :: ReadPrec [LineNum]
readPrec :: ReadPrec LineNum
$creadPrec :: ReadPrec LineNum
readList :: ReadS [LineNum]
$creadList :: ReadS [LineNum]
readsPrec :: Int -> ReadS LineNum
$creadsPrec :: Int -> ReadS LineNum
Read, Int -> LineNum -> ShowS
[LineNum] -> ShowS
LineNum -> String
(Int -> LineNum -> ShowS)
-> (LineNum -> String) -> ([LineNum] -> ShowS) -> Show LineNum
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LineNum] -> ShowS
$cshowList :: [LineNum] -> ShowS
show :: LineNum -> String
$cshow :: LineNum -> String
showsPrec :: Int -> LineNum -> ShowS
$cshowsPrec :: Int -> LineNum -> ShowS
Show, Typeable)

data PrinterState = PrinterState
  { PrinterState -> LineNum
currLine :: {-# UNPACK #-} !LineNum
  , PrinterState -> NestLevel
nestLevel :: {-# UNPACK #-} !NestLevel
  } deriving (PrinterState -> PrinterState -> Bool
(PrinterState -> PrinterState -> Bool)
-> (PrinterState -> PrinterState -> Bool) -> Eq PrinterState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PrinterState -> PrinterState -> Bool
$c/= :: PrinterState -> PrinterState -> Bool
== :: PrinterState -> PrinterState -> Bool
$c== :: PrinterState -> PrinterState -> Bool
Eq, Typeable PrinterState
Constr
DataType
Typeable PrinterState =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> PrinterState -> c PrinterState)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c PrinterState)
-> (PrinterState -> Constr)
-> (PrinterState -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c PrinterState))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c PrinterState))
-> ((forall b. Data b => b -> b) -> PrinterState -> PrinterState)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> PrinterState -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> PrinterState -> r)
-> (forall u. (forall d. Data d => d -> u) -> PrinterState -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> PrinterState -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> PrinterState -> m PrinterState)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> PrinterState -> m PrinterState)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> PrinterState -> m PrinterState)
-> Data PrinterState
PrinterState -> Constr
PrinterState -> DataType
(forall b. Data b => b -> b) -> PrinterState -> PrinterState
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PrinterState -> c PrinterState
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PrinterState
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> PrinterState -> u
forall u. (forall d. Data d => d -> u) -> PrinterState -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PrinterState -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PrinterState -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PrinterState -> m PrinterState
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PrinterState -> m PrinterState
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PrinterState
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PrinterState -> c PrinterState
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PrinterState)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PrinterState)
$cPrinterState :: Constr
$tPrinterState :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> PrinterState -> m PrinterState
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PrinterState -> m PrinterState
gmapMp :: (forall d. Data d => d -> m d) -> PrinterState -> m PrinterState
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PrinterState -> m PrinterState
gmapM :: (forall d. Data d => d -> m d) -> PrinterState -> m PrinterState
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PrinterState -> m PrinterState
gmapQi :: Int -> (forall d. Data d => d -> u) -> PrinterState -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PrinterState -> u
gmapQ :: (forall d. Data d => d -> u) -> PrinterState -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> PrinterState -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PrinterState -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PrinterState -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PrinterState -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PrinterState -> r
gmapT :: (forall b. Data b => b -> b) -> PrinterState -> PrinterState
$cgmapT :: (forall b. Data b => b -> b) -> PrinterState -> PrinterState
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PrinterState)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PrinterState)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c PrinterState)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PrinterState)
dataTypeOf :: PrinterState -> DataType
$cdataTypeOf :: PrinterState -> DataType
toConstr :: PrinterState -> Constr
$ctoConstr :: PrinterState -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PrinterState
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PrinterState
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PrinterState -> c PrinterState
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PrinterState -> c PrinterState
$cp1Data :: Typeable PrinterState
Data, (forall x. PrinterState -> Rep PrinterState x)
-> (forall x. Rep PrinterState x -> PrinterState)
-> Generic PrinterState
forall x. Rep PrinterState x -> PrinterState
forall x. PrinterState -> Rep PrinterState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PrinterState x -> PrinterState
$cfrom :: forall x. PrinterState -> Rep PrinterState x
Generic, Int -> PrinterState -> ShowS
[PrinterState] -> ShowS
PrinterState -> String
(Int -> PrinterState -> ShowS)
-> (PrinterState -> String)
-> ([PrinterState] -> ShowS)
-> Show PrinterState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PrinterState] -> ShowS
$cshowList :: [PrinterState] -> ShowS
show :: PrinterState -> String
$cshow :: PrinterState -> String
showsPrec :: Int -> PrinterState -> ShowS
$cshowsPrec :: Int -> PrinterState -> ShowS
Show, Typeable)

-- | Smart-constructor for 'PrinterState'.
printerState :: LineNum -> NestLevel -> PrinterState
printerState :: LineNum -> NestLevel -> PrinterState
printerState currLineNum :: LineNum
currLineNum nestNum :: NestLevel
nestNum =
  $WPrinterState :: LineNum -> NestLevel -> PrinterState
PrinterState
  { currLine :: LineNum
currLine = LineNum
currLineNum
  , nestLevel :: NestLevel
nestLevel = NestLevel
nestNum
  }


addOutput
  :: MonadState PrinterState m
  => OutputType -> m Output
addOutput :: OutputType -> m Output
addOutput outputType :: OutputType
outputType = do
  NestLevel
nest <- (PrinterState -> NestLevel) -> m NestLevel
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PrinterState -> NestLevel
nestLevel
  Output -> m Output
forall (m :: * -> *) a. Monad m => a -> m a
return (Output -> m Output) -> Output -> m Output
forall a b. (a -> b) -> a -> b
$ NestLevel -> OutputType -> Output
Output NestLevel
nest OutputType
outputType

addOutputs
  :: MonadState PrinterState m
  => [OutputType] -> m [Output]
addOutputs :: [OutputType] -> m [Output]
addOutputs outputTypes :: [OutputType]
outputTypes = do
  NestLevel
nest <- (PrinterState -> NestLevel) -> m NestLevel
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PrinterState -> NestLevel
nestLevel
  [Output] -> m [Output]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Output] -> m [Output]) -> [Output] -> m [Output]
forall a b. (a -> b) -> a -> b
$ NestLevel -> OutputType -> Output
Output NestLevel
nest (OutputType -> Output) -> [OutputType] -> [Output]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [OutputType]
outputTypes

initPrinterState :: PrinterState
initPrinterState :: PrinterState
initPrinterState = LineNum -> NestLevel -> PrinterState
printerState 0 (-1)

-- | Print a surrounding expression (like @\[\]@ or @\{\}@ or @\(\)@).
--
-- If the 'CommaSeparated' expressions are empty, just print the start and end
-- markers.
--
-- >>> testInit $ putSurroundExpr "[" "]" (CommaSeparated [])
-- [Output {outputNestLevel = NestLevel {unNestLevel = 0}, outputOutputType = OutputOpenBracket},Output {outputNestLevel = NestLevel {unNestLevel = 0}, outputOutputType = OutputCloseBracket}]
--
-- If there is only one expression, and it will print out on one line, then
-- just print everything all on one line, with spaces around the expressions.
--
-- >>> testInit $ putSurroundExpr "{" "}" (CommaSeparated [[Other "hello"]])
-- [Output {outputNestLevel = NestLevel {unNestLevel = 0}, outputOutputType = OutputOpenBrace},Output {outputNestLevel = NestLevel {unNestLevel = 0}, outputOutputType = OutputOther " "},Output {outputNestLevel = NestLevel {unNestLevel = 0}, outputOutputType = OutputOther "hello"},Output {outputNestLevel = NestLevel {unNestLevel = 0}, outputOutputType = OutputOther " "},Output {outputNestLevel = NestLevel {unNestLevel = 0}, outputOutputType = OutputCloseBrace}]
--
-- If there is only one expression, but it will print out on multiple lines,
-- then go to newline and print out on multiple lines.
--
-- >>> 1 + 1  -- TODO: Example here.
-- 2
--
-- If there are multiple expressions, then first go to a newline.
-- Print out on multiple lines.
--
-- >>> 1 + 1  -- TODO: Example here.
-- 2
putSurroundExpr
  :: MonadState PrinterState m
  => OutputType
  -> OutputType
  -> CommaSeparated [Expr] -- ^ comma separated inner expression.
  -> m [Output]
putSurroundExpr :: OutputType -> OutputType -> CommaSeparated [Expr] -> m [Output]
putSurroundExpr startOutputType :: OutputType
startOutputType endOutputType :: OutputType
endOutputType (CommaSeparated []) = do
  NestLevel -> m ()
forall (m :: * -> *).
MonadState PrinterState m =>
NestLevel -> m ()
addToNestLevel 1
  [Output]
outputs <- [OutputType] -> m [Output]
forall (m :: * -> *).
MonadState PrinterState m =>
[OutputType] -> m [Output]
addOutputs [Item [OutputType]
OutputType
startOutputType, Item [OutputType]
OutputType
endOutputType]
  NestLevel -> m ()
forall (m :: * -> *).
MonadState PrinterState m =>
NestLevel -> m ()
addToNestLevel (-1)
  [Output] -> m [Output]
forall (m :: * -> *) a. Monad m => a -> m a
return [Output]
outputs
putSurroundExpr startOutputType :: OutputType
startOutputType endOutputType :: OutputType
endOutputType (CommaSeparated [exprs :: Item [[Expr]]
exprs]) = do
  NestLevel -> m ()
forall (m :: * -> *).
MonadState PrinterState m =>
NestLevel -> m ()
addToNestLevel 1
  let (thisLayerMulti :: Bool
thisLayerMulti, nextLayerMulti :: Bool
nextLayerMulti) = [Expr] -> (Bool, Bool)
thisAndNextMulti [Expr]
Item [[Expr]]
exprs

  [Output]
maybeNL <- if Bool
thisLayerMulti
               then m [Output]
forall (m :: * -> *). MonadState PrinterState m => m [Output]
newLineAndDoIndent
               else [Output] -> m [Output]
forall (m :: * -> *) a. Monad m => a -> m a
return []
  [Output]
start <- [OutputType] -> m [Output]
forall (m :: * -> *).
MonadState PrinterState m =>
[OutputType] -> m [Output]
addOutputs [Item [OutputType]
OutputType
startOutputType, String -> OutputType
OutputOther " "]
  [Output]
middle <- [[Output]] -> [Output]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Output]] -> [Output]) -> m [[Output]] -> m [Output]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Expr -> m [Output]) -> [Expr] -> m [[Output]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Expr -> m [Output]
forall (m :: * -> *).
MonadState PrinterState m =>
Expr -> m [Output]
putExpression [Expr]
Item [[Expr]]
exprs
  [Output]
nlOrSpace <- if Bool
nextLayerMulti
                 then m [Output]
forall (m :: * -> *). MonadState PrinterState m => m [Output]
newLineAndDoIndent
                 else (Output -> [Output] -> [Output]
forall a. a -> [a] -> [a]
:[]) (Output -> [Output]) -> m Output -> m [Output]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (OutputType -> m Output
forall (m :: * -> *).
MonadState PrinterState m =>
OutputType -> m Output
addOutput (OutputType -> m Output) -> OutputType -> m Output
forall a b. (a -> b) -> a -> b
$ String -> OutputType
OutputOther " ")
  Output
end <- OutputType -> m Output
forall (m :: * -> *).
MonadState PrinterState m =>
OutputType -> m Output
addOutput OutputType
endOutputType

  NestLevel -> m ()
forall (m :: * -> *).
MonadState PrinterState m =>
NestLevel -> m ()
addToNestLevel (-1)

  [Output] -> m [Output]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Output] -> m [Output]) -> [Output] -> m [Output]
forall a b. (a -> b) -> a -> b
$ [Output]
maybeNL [Output] -> [Output] -> [Output]
forall a. Semigroup a => a -> a -> a
<> [Output]
start [Output] -> [Output] -> [Output]
forall a. Semigroup a => a -> a -> a
<> [Output]
middle [Output] -> [Output] -> [Output]
forall a. Semigroup a => a -> a -> a
<> [Output]
nlOrSpace [Output] -> [Output] -> [Output]
forall a. Semigroup a => a -> a -> a
<> [Item [Output]
Output
end]
  where
    thisAndNextMulti :: [Expr] -> (Bool, Bool)
thisAndNextMulti = (\(a :: [Bool]
a,b :: [Bool]
b) -> ([Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or [Bool]
a, [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or [Bool]
b)) (([Bool], [Bool]) -> (Bool, Bool))
-> ([Expr] -> ([Bool], [Bool])) -> [Expr] -> (Bool, Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Bool, Bool)] -> ([Bool], [Bool])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(Bool, Bool)] -> ([Bool], [Bool]))
-> ([Expr] -> [(Bool, Bool)]) -> [Expr] -> ([Bool], [Bool])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Expr -> (Bool, Bool)) -> [Expr] -> [(Bool, Bool)]
forall a b. (a -> b) -> [a] -> [b]
map Expr -> (Bool, Bool)
isMultiLine

    isMultiLine :: Expr -> (Bool, Bool)
isMultiLine (Brackets commaSeparated :: CommaSeparated [Expr]
commaSeparated) = CommaSeparated [Expr] -> (Bool, Bool)
isMultiLine' CommaSeparated [Expr]
commaSeparated
    isMultiLine (Braces commaSeparated :: CommaSeparated [Expr]
commaSeparated) = CommaSeparated [Expr] -> (Bool, Bool)
isMultiLine' CommaSeparated [Expr]
commaSeparated
    isMultiLine (Parens commaSeparated :: CommaSeparated [Expr]
commaSeparated) = CommaSeparated [Expr] -> (Bool, Bool)
isMultiLine' CommaSeparated [Expr]
commaSeparated
    isMultiLine _ = (Bool
False, Bool
False)

    isMultiLine' :: CommaSeparated [Expr] -> (Bool, Bool)
isMultiLine' (CommaSeparated []) = (Bool
False, Bool
False)
    isMultiLine' (CommaSeparated [es :: Item [[Expr]]
es]) = (Bool
True, (Bool, Bool) -> Bool
forall a b. (a, b) -> a
fst ((Bool, Bool) -> Bool) -> (Bool, Bool) -> Bool
forall a b. (a -> b) -> a -> b
$ [Expr] -> (Bool, Bool)
thisAndNextMulti [Expr]
Item [[Expr]]
es)
    isMultiLine' _ = (Bool
True, Bool
True)
putSurroundExpr startOutputType :: OutputType
startOutputType endOutputType :: OutputType
endOutputType commaSeparated :: CommaSeparated [Expr]
commaSeparated = do
  NestLevel -> m ()
forall (m :: * -> *).
MonadState PrinterState m =>
NestLevel -> m ()
addToNestLevel 1
  [Output]
nl <- m [Output]
forall (m :: * -> *). MonadState PrinterState m => m [Output]
newLineAndDoIndent
  [Output]
start <- [OutputType] -> m [Output]
forall (m :: * -> *).
MonadState PrinterState m =>
[OutputType] -> m [Output]
addOutputs [Item [OutputType]
OutputType
startOutputType, String -> OutputType
OutputOther " "]
  [Output]
middle <- CommaSeparated [Expr] -> m [Output]
forall (m :: * -> *).
MonadState PrinterState m =>
CommaSeparated [Expr] -> m [Output]
putCommaSep CommaSeparated [Expr]
commaSeparated
  [Output]
nl2 <- m [Output]
forall (m :: * -> *). MonadState PrinterState m => m [Output]
newLineAndDoIndent
  Output
end <- OutputType -> m Output
forall (m :: * -> *).
MonadState PrinterState m =>
OutputType -> m Output
addOutput OutputType
endOutputType
  NestLevel -> m ()
forall (m :: * -> *).
MonadState PrinterState m =>
NestLevel -> m ()
addToNestLevel (-1)
  Output
endSpace <- OutputType -> m Output
forall (m :: * -> *).
MonadState PrinterState m =>
OutputType -> m Output
addOutput (OutputType -> m Output) -> OutputType -> m Output
forall a b. (a -> b) -> a -> b
$ String -> OutputType
OutputOther " "

  [Output] -> m [Output]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Output] -> m [Output]) -> [Output] -> m [Output]
forall a b. (a -> b) -> a -> b
$ [Output]
nl [Output] -> [Output] -> [Output]
forall a. Semigroup a => a -> a -> a
<> [Output]
start [Output] -> [Output] -> [Output]
forall a. Semigroup a => a -> a -> a
<> [Output]
middle [Output] -> [Output] -> [Output]
forall a. Semigroup a => a -> a -> a
<> [Output]
nl2 [Output] -> [Output] -> [Output]
forall a. Semigroup a => a -> a -> a
<> [Item [Output]
Output
end, Item [Output]
Output
endSpace]


putCommaSep
  :: forall m.
     MonadState PrinterState m
  => CommaSeparated [Expr] -> m [Output]
putCommaSep :: CommaSeparated [Expr] -> m [Output]
putCommaSep (CommaSeparated expressionsList :: [[Expr]]
expressionsList) =
  [[Output]] -> [Output]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Output]] -> [Output]) -> m [[Output]] -> m [Output]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([m [Output]] -> m [[Output]]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([m [Output]] -> m [[Output]]) -> [m [Output]] -> m [[Output]]
forall a b. (a -> b) -> a -> b
$ m [Output] -> [m [Output]] -> [m [Output]]
forall a. a -> [a] -> [a]
intersperse m [Output]
forall (m :: * -> *). MonadState PrinterState m => m [Output]
putComma [m [Output]]
evaledExpressionList)
  where
    evaledExpressionList :: [m [Output]]
    evaledExpressionList :: [m [Output]]
evaledExpressionList =
      ([[Output]] -> [Output]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Output]] -> [Output])
-> ([Expr] -> m [[Output]]) -> [Expr] -> m [Output]
forall (f :: * -> *) a b t.
Functor f =>
(a -> b) -> (t -> f a) -> t -> f b
<.> (Expr -> m [Output]) -> [Expr] -> m [[Output]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Expr -> m [Output]
forall (m :: * -> *).
MonadState PrinterState m =>
Expr -> m [Output]
putExpression) ([Expr] -> m [Output]) -> [[Expr]] -> [m [Output]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Expr]]
expressionsList

    (f :: a -> b
f <.> :: (a -> b) -> (t -> f a) -> t -> f b
<.> g :: t -> f a
g) x :: t
x = a -> b
f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t -> f a
g t
x

putComma
  :: MonadState PrinterState m
  => m [Output]
putComma :: m [Output]
putComma = do
  [Output]
nl <- m [Output]
forall (m :: * -> *). MonadState PrinterState m => m [Output]
newLineAndDoIndent
  [Output]
outputs <- [OutputType] -> m [Output]
forall (m :: * -> *).
MonadState PrinterState m =>
[OutputType] -> m [Output]
addOutputs [Item [OutputType]
OutputType
OutputComma, String -> OutputType
OutputOther " "]
  [Output] -> m [Output]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Output] -> m [Output]) -> [Output] -> m [Output]
forall a b. (a -> b) -> a -> b
$ [Output]
nl [Output] -> [Output] -> [Output]
forall a. Semigroup a => a -> a -> a
<> [Output]
outputs

doIndent :: MonadState PrinterState m => m [Output]
doIndent :: m [Output]
doIndent = do
  Int
nest <- (PrinterState -> Int) -> m Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((PrinterState -> Int) -> m Int) -> (PrinterState -> Int) -> m Int
forall a b. (a -> b) -> a -> b
$ NestLevel -> Int
unNestLevel (NestLevel -> Int)
-> (PrinterState -> NestLevel) -> PrinterState -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrinterState -> NestLevel
nestLevel
  [OutputType] -> m [Output]
forall (m :: * -> *).
MonadState PrinterState m =>
[OutputType] -> m [Output]
addOutputs ([OutputType] -> m [Output]) -> [OutputType] -> m [Output]
forall a b. (a -> b) -> a -> b
$ Int -> OutputType -> [OutputType]
forall a. Int -> a -> [a]
replicate Int
nest OutputType
OutputIndent

newLine
  :: MonadState PrinterState m
  => m Output
newLine :: m Output
newLine = do
  Output
output <- OutputType -> m Output
forall (m :: * -> *).
MonadState PrinterState m =>
OutputType -> m Output
addOutput OutputType
OutputNewLine
  LineNum -> m ()
forall (m :: * -> *). MonadState PrinterState m => LineNum -> m ()
addToCurrentLine 1
  Output -> m Output
forall (m :: * -> *) a. Monad m => a -> m a
return Output
output

newLineAndDoIndent
  :: MonadState PrinterState m
  => m [Output]
newLineAndDoIndent :: m [Output]
newLineAndDoIndent = do
  Output
nl <- m Output
forall (m :: * -> *). MonadState PrinterState m => m Output
newLine
  [Output]
indent <- m [Output]
forall (m :: * -> *). MonadState PrinterState m => m [Output]
doIndent
  [Output] -> m [Output]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Output] -> m [Output]) -> [Output] -> m [Output]
forall a b. (a -> b) -> a -> b
$ Output
nlOutput -> [Output] -> [Output]
forall a. a -> [a] -> [a]
:[Output]
indent

addToNestLevel
  :: MonadState PrinterState m
  => NestLevel -> m ()
addToNestLevel :: NestLevel -> m ()
addToNestLevel diff :: NestLevel
diff =
  (PrinterState -> PrinterState) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\printState :: PrinterState
printState -> PrinterState
printState {nestLevel :: NestLevel
nestLevel = PrinterState -> NestLevel
nestLevel PrinterState
printState NestLevel -> NestLevel -> NestLevel
forall a. Num a => a -> a -> a
+ NestLevel
diff})

addToCurrentLine
  :: MonadState PrinterState m
  => LineNum -> m ()
addToCurrentLine :: LineNum -> m ()
addToCurrentLine diff :: LineNum
diff =
  (PrinterState -> PrinterState) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\printState :: PrinterState
printState -> PrinterState
printState {currLine :: LineNum
currLine = PrinterState -> LineNum
currLine PrinterState
printState LineNum -> LineNum -> LineNum
forall a. Num a => a -> a -> a
+ LineNum
diff})

putExpression :: MonadState PrinterState m => Expr -> m [Output]
putExpression :: Expr -> m [Output]
putExpression (Brackets commaSeparated :: CommaSeparated [Expr]
commaSeparated) =
  OutputType -> OutputType -> CommaSeparated [Expr] -> m [Output]
forall (m :: * -> *).
MonadState PrinterState m =>
OutputType -> OutputType -> CommaSeparated [Expr] -> m [Output]
putSurroundExpr OutputType
OutputOpenBracket OutputType
OutputCloseBracket CommaSeparated [Expr]
commaSeparated
putExpression (Braces commaSeparated :: CommaSeparated [Expr]
commaSeparated) =
  OutputType -> OutputType -> CommaSeparated [Expr] -> m [Output]
forall (m :: * -> *).
MonadState PrinterState m =>
OutputType -> OutputType -> CommaSeparated [Expr] -> m [Output]
putSurroundExpr OutputType
OutputOpenBrace OutputType
OutputCloseBrace CommaSeparated [Expr]
commaSeparated
putExpression (Parens commaSeparated :: CommaSeparated [Expr]
commaSeparated) =
  OutputType -> OutputType -> CommaSeparated [Expr] -> m [Output]
forall (m :: * -> *).
MonadState PrinterState m =>
OutputType -> OutputType -> CommaSeparated [Expr] -> m [Output]
putSurroundExpr OutputType
OutputOpenParen OutputType
OutputCloseParen CommaSeparated [Expr]
commaSeparated
putExpression (StringLit string :: String
string) = do
  NestLevel
nest <- (PrinterState -> NestLevel) -> m NestLevel
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PrinterState -> NestLevel
nestLevel
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (NestLevel
nest NestLevel -> NestLevel -> Bool
forall a. Ord a => a -> a -> Bool
< 0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ NestLevel -> m ()
forall (m :: * -> *).
MonadState PrinterState m =>
NestLevel -> m ()
addToNestLevel 1
  [OutputType] -> m [Output]
forall (m :: * -> *).
MonadState PrinterState m =>
[OutputType] -> m [Output]
addOutputs [String -> OutputType
OutputStringLit String
string, String -> OutputType
OutputOther " "]
putExpression (CharLit string :: String
string) = do
  NestLevel
nest <- (PrinterState -> NestLevel) -> m NestLevel
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PrinterState -> NestLevel
nestLevel
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (NestLevel
nest NestLevel -> NestLevel -> Bool
forall a. Ord a => a -> a -> Bool
< 0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ NestLevel -> m ()
forall (m :: * -> *).
MonadState PrinterState m =>
NestLevel -> m ()
addToNestLevel 1
  [OutputType] -> m [Output]
forall (m :: * -> *).
MonadState PrinterState m =>
[OutputType] -> m [Output]
addOutputs [String -> OutputType
OutputCharLit String
string, String -> OutputType
OutputOther " "]
putExpression (NumberLit integer :: String
integer) = do
  NestLevel
nest <- (PrinterState -> NestLevel) -> m NestLevel
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PrinterState -> NestLevel
nestLevel
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (NestLevel
nest NestLevel -> NestLevel -> Bool
forall a. Ord a => a -> a -> Bool
< 0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ NestLevel -> m ()
forall (m :: * -> *).
MonadState PrinterState m =>
NestLevel -> m ()
addToNestLevel 1
  (Output -> [Output] -> [Output]
forall a. a -> [a] -> [a]
:[]) (Output -> [Output]) -> m Output -> m [Output]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (OutputType -> m Output
forall (m :: * -> *).
MonadState PrinterState m =>
OutputType -> m Output
addOutput (OutputType -> m Output) -> OutputType -> m Output
forall a b. (a -> b) -> a -> b
$ String -> OutputType
OutputNumberLit String
integer)
putExpression (Other string :: String
string) = do
  NestLevel
nest <- (PrinterState -> NestLevel) -> m NestLevel
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PrinterState -> NestLevel
nestLevel
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (NestLevel
nest NestLevel -> NestLevel -> Bool
forall a. Ord a => a -> a -> Bool
< 0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ NestLevel -> m ()
forall (m :: * -> *).
MonadState PrinterState m =>
NestLevel -> m ()
addToNestLevel 1
  (Output -> [Output] -> [Output]
forall a. a -> [a] -> [a]
:[]) (Output -> [Output]) -> m Output -> m [Output]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (OutputType -> m Output
forall (m :: * -> *).
MonadState PrinterState m =>
OutputType -> m Output
addOutput (OutputType -> m Output) -> OutputType -> m Output
forall a b. (a -> b) -> a -> b
$ String -> OutputType
OutputOther String
string)

runPrinterState :: PrinterState -> [Expr] -> [Output]
runPrinterState :: PrinterState -> [Expr] -> [Output]
runPrinterState initState :: PrinterState
initState expressions :: [Expr]
expressions =
  [[Output]] -> [Output]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Output]] -> [Output]) -> [[Output]] -> [Output]
forall a b. (a -> b) -> a -> b
$ State PrinterState [[Output]] -> PrinterState -> [[Output]]
forall s a. State s a -> s -> a
evalState ((Expr -> StateT PrinterState Identity [Output])
-> [Expr] -> State PrinterState [[Output]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Expr -> StateT PrinterState Identity [Output]
forall (m :: * -> *).
MonadState PrinterState m =>
Expr -> m [Output]
putExpression [Expr]
expressions) PrinterState
initState

runInitPrinterState :: [Expr] -> [Output]
runInitPrinterState :: [Expr] -> [Output]
runInitPrinterState = PrinterState -> [Expr] -> [Output]
runPrinterState PrinterState
initPrinterState

expressionsToOutputs :: [Expr] -> [Output]
expressionsToOutputs :: [Expr] -> [Output]
expressionsToOutputs = [Expr] -> [Output]
runInitPrinterState ([Expr] -> [Output]) -> ([Expr] -> [Expr]) -> [Expr] -> [Output]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Expr] -> [Expr]
modificationsExprList

-- | A function that performs optimizations and modifications to a list of
-- input 'Expr's.
--
-- An sample of an optimization is 'removeEmptyInnerCommaSeparatedExprList'
-- which removes empty inner lists in a 'CommaSeparated' value.
modificationsExprList :: [Expr] -> [Expr]
modificationsExprList :: [Expr] -> [Expr]
modificationsExprList = [Expr] -> [Expr]
removeEmptyInnerCommaSeparatedExprList

removeEmptyInnerCommaSeparatedExprList :: [Expr] -> [Expr]
removeEmptyInnerCommaSeparatedExprList :: [Expr] -> [Expr]
removeEmptyInnerCommaSeparatedExprList = (Expr -> Expr) -> [Expr] -> [Expr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Expr -> Expr
removeEmptyInnerCommaSeparatedExpr

removeEmptyInnerCommaSeparatedExpr :: Expr -> Expr
removeEmptyInnerCommaSeparatedExpr :: Expr -> Expr
removeEmptyInnerCommaSeparatedExpr (Brackets commaSeparated :: CommaSeparated [Expr]
commaSeparated) =
  CommaSeparated [Expr] -> Expr
Brackets (CommaSeparated [Expr] -> Expr) -> CommaSeparated [Expr] -> Expr
forall a b. (a -> b) -> a -> b
$ CommaSeparated [Expr] -> CommaSeparated [Expr]
removeEmptyInnerCommaSeparated CommaSeparated [Expr]
commaSeparated
removeEmptyInnerCommaSeparatedExpr (Braces commaSeparated :: CommaSeparated [Expr]
commaSeparated) =
  CommaSeparated [Expr] -> Expr
Braces (CommaSeparated [Expr] -> Expr) -> CommaSeparated [Expr] -> Expr
forall a b. (a -> b) -> a -> b
$ CommaSeparated [Expr] -> CommaSeparated [Expr]
removeEmptyInnerCommaSeparated CommaSeparated [Expr]
commaSeparated
removeEmptyInnerCommaSeparatedExpr (Parens commaSeparated :: CommaSeparated [Expr]
commaSeparated) =
  CommaSeparated [Expr] -> Expr
Parens (CommaSeparated [Expr] -> Expr) -> CommaSeparated [Expr] -> Expr
forall a b. (a -> b) -> a -> b
$ CommaSeparated [Expr] -> CommaSeparated [Expr]
removeEmptyInnerCommaSeparated CommaSeparated [Expr]
commaSeparated
removeEmptyInnerCommaSeparatedExpr other :: Expr
other = Expr
other

removeEmptyInnerCommaSeparated :: CommaSeparated [Expr] -> CommaSeparated [Expr]
removeEmptyInnerCommaSeparated :: CommaSeparated [Expr] -> CommaSeparated [Expr]
removeEmptyInnerCommaSeparated (CommaSeparated commaSeps :: [[Expr]]
commaSeps) =
  [[Expr]] -> CommaSeparated [Expr]
forall a. [a] -> CommaSeparated a
CommaSeparated ([[Expr]] -> CommaSeparated [Expr])
-> ([[Expr]] -> [[Expr]]) -> [[Expr]] -> CommaSeparated [Expr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Expr] -> [Expr]) -> [[Expr]] -> [[Expr]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Expr] -> [Expr]
removeEmptyInnerCommaSeparatedExprList ([[Expr]] -> CommaSeparated [Expr])
-> [[Expr]] -> CommaSeparated [Expr]
forall a b. (a -> b) -> a -> b
$
  [[Expr]] -> [[Expr]]
forall a. [[a]] -> [[a]]
removeEmptyList [[Expr]]
commaSeps

-- | Remove empty lists from a list of lists.
--
-- >>> removeEmptyList [[1,2,3], [], [4,5]]
-- [[1,2,3],[4,5]]
--
-- >>> removeEmptyList [[]]
-- []
--
-- >>> removeEmptyList [[1]]
-- [[1]]
--
-- >>> removeEmptyList [[1,2], [10,20], [100,200]]
-- [[1,2],[10,20],[100,200]]
removeEmptyList :: forall a . [[a]] -> [[a]]
removeEmptyList :: [[a]] -> [[a]]
removeEmptyList = ([a] -> [[a]] -> [[a]]) -> [[a]] -> [[a]] -> [[a]]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr [a] -> [[a]] -> [[a]]
f []
  where
    f :: [a] -> [[a]] -> [[a]]
    f :: [a] -> [[a]] -> [[a]]
f [] accum :: [[a]]
accum = [[a]]
accum
    f a :: [a]
a accum :: [[a]]
accum = [[a]
Item [[a]]
a] [[a]] -> [[a]] -> [[a]]
forall a. Semigroup a => a -> a -> a
<> [[a]]
accum