module GOOL.Drasil.Helpers (angles, doubleQuotedText, hicat, vicat, vibcat, 
  vmap, vimap, emptyIfEmpty, emptyIfNull, toCode, toState, onCodeValue, 
  onStateValue, on2CodeValues, on2StateValues, on3CodeValues, on3StateValues, 
  onCodeList, onStateList, on2StateLists, getInnerType, on2StateWrapped, 
  getNestDegree
) where

import Utils.Drasil (blank)

import qualified GOOL.Drasil.CodeType as C (CodeType(..))

import Prelude hiding ((<>))
import Control.Applicative (liftA2, liftA3)
import Control.Monad (liftM2, liftM3)
import Control.Monad.State (State)
import Data.List (intersperse)
import Text.PrettyPrint.HughesPJ (Doc, vcat, hcat, text, char, doubleQuotes, 
  (<>), empty, isEmpty)

angles :: Doc -> Doc
angles :: Doc -> Doc
angles Doc
d = Char -> Doc
char Char
'<' Doc -> Doc -> Doc
<> Doc
d Doc -> Doc -> Doc
<> Char -> Doc
char Char
'>'

doubleQuotedText :: String -> Doc
doubleQuotedText :: String -> Doc
doubleQuotedText = Doc -> Doc
doubleQuotes forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Doc
text

hicat :: Doc -> [Doc] -> Doc
hicat :: Doc -> [Doc] -> Doc
hicat Doc
c [Doc]
l = [Doc] -> Doc
hcat forall a b. (a -> b) -> a -> b
$ forall a. a -> [a] -> [a]
intersperse Doc
c [Doc]
l

vicat :: Doc -> [Doc] -> Doc
vicat :: Doc -> [Doc] -> Doc
vicat Doc
c = [Doc] -> Doc
vcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> [a] -> [a]
intersperse Doc
c forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Bool
isEmpty)

vibcat :: [Doc] -> Doc
vibcat :: [Doc] -> Doc
vibcat = Doc -> [Doc] -> Doc
vicat Doc
blank

vmap :: (a -> Doc) -> [a] -> Doc
vmap :: forall a. (a -> Doc) -> [a] -> Doc
vmap a -> Doc
f = [Doc] -> Doc
vcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map a -> Doc
f

vimap :: Doc -> (a -> Doc) -> [a] -> Doc
vimap :: forall a. Doc -> (a -> Doc) -> [a] -> Doc
vimap Doc
c a -> Doc
f = Doc -> [Doc] -> Doc
vicat Doc
c forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map a -> Doc
f

emptyIfEmpty :: Doc -> Doc -> Doc
emptyIfEmpty :: Doc -> Doc -> Doc
emptyIfEmpty Doc
ifDoc Doc
elseDoc = if Doc -> Bool
isEmpty Doc
ifDoc then Doc
empty else Doc
elseDoc

emptyIfNull :: [a] -> Doc -> Doc
emptyIfNull :: forall a. [a] -> Doc -> Doc
emptyIfNull [a]
lst Doc
elseDoc = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
lst then Doc
empty else Doc
elseDoc

toCode :: (Monad r) => a -> r a
toCode :: forall (r :: * -> *) a. Monad r => a -> r a
toCode = forall (m :: * -> *) a. Monad m => a -> m a
return

toState :: a -> State s a
toState :: forall a s. a -> State s a
toState = forall (m :: * -> *) a. Monad m => a -> m a
return

onCodeValue :: (Functor r) => (a -> b) -> r a -> r b
onCodeValue :: forall (r :: * -> *) a b. Functor r => (a -> b) -> r a -> r b
onCodeValue = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap

onStateValue :: (a -> b) -> State s a -> State s b
onStateValue :: forall a b s. (a -> b) -> State s a -> State s b
onStateValue = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap

on2CodeValues :: (Applicative r) => (a -> b -> c) -> r a -> r b -> 
  r c
on2CodeValues :: forall (r :: * -> *) a b c.
Applicative r =>
(a -> b -> c) -> r a -> r b -> r c
on2CodeValues = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2

on2StateValues :: (a -> b -> c) -> State s a -> State s b -> State s c
on2StateValues :: forall a b c s.
(a -> b -> c) -> State s a -> State s b -> State s c
on2StateValues = forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2

on3CodeValues :: (Applicative r) => (a -> b -> c -> d) -> r a -> r b 
  -> r c -> r d
on3CodeValues :: forall (r :: * -> *) a b c d.
Applicative r =>
(a -> b -> c -> d) -> r a -> r b -> r c -> r d
on3CodeValues = forall (r :: * -> *) a b c d.
Applicative r =>
(a -> b -> c -> d) -> r a -> r b -> r c -> r d
liftA3

on3StateValues :: (a -> b -> c -> d) -> State s a -> State s b -> State s c ->
  State s d
on3StateValues :: forall a b c d s.
(a -> b -> c -> d)
-> State s a -> State s b -> State s c -> State s d
on3StateValues = forall (m :: * -> *) a1 a2 a3 r.
Monad m =>
(a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r
liftM3

onCodeList :: Monad m => ([a] -> b) -> [m a] -> m b
onCodeList :: forall (m :: * -> *) a b. Monad m => ([a] -> b) -> [m a] -> m b
onCodeList [a] -> b
f [m a]
as = [a] -> b
f forall (r :: * -> *) a b. Functor r => (a -> b) -> r a -> r b
<$> forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [m a]
as

onStateList :: ([a] -> b) -> [State s a] -> State s b
onStateList :: forall a b s. ([a] -> b) -> [State s a] -> State s b
onStateList [a] -> b
f [State s a]
as = [a] -> b
f forall (r :: * -> *) a b. Functor r => (a -> b) -> r a -> r b
<$> forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [State s a]
as

on2StateLists :: ([a] -> [b] -> c) -> [State s a] -> [State s b] -> State s c
on2StateLists :: forall a b c s.
([a] -> [b] -> c) -> [State s a] -> [State s b] -> State s c
on2StateLists [a] -> [b] -> c
f [State s a]
as [State s b]
bs = forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 [a] -> [b] -> c
f (forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [State s a]
as) (forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [State s b]
bs)

on2StateWrapped :: (Monad m) => (a -> b -> m c) -> m a -> m b -> m c
on2StateWrapped :: forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> m c) -> m a -> m b -> m c
on2StateWrapped a -> b -> m c
f m a
a' m b
b' = do 
    a
a <- m a
a'
    b
b <- m b
b'
    a -> b -> m c
f a
a b
b 

getInnerType :: C.CodeType -> C.CodeType
getInnerType :: CodeType -> CodeType
getInnerType (C.List CodeType
innerT) = CodeType
innerT
getInnerType (C.Array CodeType
innerT) = CodeType
innerT
getInnerType CodeType
_ = forall a. HasCallStack => String -> a
error String
"Attempt to extract inner type of list from a non-list type" 

getNestDegree :: Integer -> C.CodeType -> Integer
getNestDegree :: Integer -> CodeType -> Integer
getNestDegree Integer
n (C.List CodeType
t) = Integer -> CodeType -> Integer
getNestDegree (Integer
nforall a. Num a => a -> a -> a
+Integer
1) CodeType
t
getNestDegree Integer
n CodeType
_ = Integer
n