{-|
Module      : Htcc.Utils.CompilationState
Description : Utilities
Copyright   : (c) roki, 2019
License     : MIT
Maintainer  : falgon53@yahoo.co.jp
Stability   : experimental
Portability : POSIX

General-purpose utilities
-}
module Htcc.Utils.CompilationState (
    CompilationState,
    itemP,
    itemsP,
    itemC,
    itemsC,
    curCD,
    itemCWhen,
    itemsCWhen,
    isSatisfied
) where

import           Control.Monad                                   (replicateM)
import           Control.Monad.Loops                             (unfoldM)
import           Control.Monad.State                             (StateT, get,
                                                                  gets, put)
import           Data.Bool                                       (bool)
import           Data.Maybe                                      (catMaybes)
import           Data.MonoTraversable                            (Element, MonoFoldable (..),
                                                                  headMay)
import qualified Data.Sequences                                  as S
import           Data.Tuple.Extra                                (first, second)

import           Htcc.Parser.ConstructionData.Scope.ManagedScope (ASTError)

-- | The state type handled during compilation.
-- It has informations required during the compilation process and input data consumed.
type CompilationState cd inp i r = StateT (cd, inp) (Either (ASTError i)) r

{-# INLINE itemP #-}
-- | `itemP` peeks at one item from input data
itemP :: MonoFoldable mono => CompilationState cd mono i (Maybe (Element mono))
itemP :: CompilationState cd mono i (Maybe (Element mono))
itemP = ((cd, mono) -> Maybe (Element mono))
-> CompilationState cd mono i (Maybe (Element mono))
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (mono -> Maybe (Element mono)
forall mono. MonoFoldable mono => mono -> Maybe (Element mono)
headMay (mono -> Maybe (Element mono))
-> ((cd, mono) -> mono) -> (cd, mono) -> Maybe (Element mono)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (cd, mono) -> mono
forall a b. (a, b) -> b
snd)

{-# INLINE itemsP #-}
-- | `itemsP` peeks at items from input data
itemsP :: (MonoFoldable mono, S.IsSequence mono) => S.Index mono -> CompilationState cd mono i (Maybe mono)
itemsP :: Index mono -> CompilationState cd mono i (Maybe mono)
itemsP n :: Index mono
n = do
    mono
x <- ((cd, mono) -> mono)
-> StateT (cd, mono) (Either (ASTError i)) mono
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Index mono -> mono -> mono
forall seq. IsSequence seq => Index seq -> seq -> seq
S.take Index mono
n (mono -> mono) -> ((cd, mono) -> mono) -> (cd, mono) -> mono
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (cd, mono) -> mono
forall a b. (a, b) -> b
snd)
    Maybe mono -> CompilationState cd mono i (Maybe mono)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe mono -> CompilationState cd mono i (Maybe mono))
-> Maybe mono -> CompilationState cd mono i (Maybe mono)
forall a b. (a -> b) -> a -> b
$ if mono -> Int
forall mono. MonoFoldable mono => mono -> Int
olength mono
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Index mono -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Index mono
n then mono -> Maybe mono
forall a. a -> Maybe a
Just mono
x else Maybe mono
forall a. Maybe a
Nothing

{-# INLINE itemC #-}
-- | `itemC` consumes at one item from input data.
-- Defines information updates by providing a function that
-- accepts the current information and one item to be consumed and returns the information
itemC :: S.IsSequence mono => (cd -> Element mono -> cd) -> CompilationState cd mono i (Maybe (Element mono))
itemC :: (cd -> Element mono -> cd)
-> CompilationState cd mono i (Maybe (Element mono))
itemC f :: cd -> Element mono -> cd
f = CompilationState cd mono i (Maybe (Element mono))
forall mono cd i.
MonoFoldable mono =>
CompilationState cd mono i (Maybe (Element mono))
itemP CompilationState cd mono i (Maybe (Element mono))
-> (Maybe (Element mono)
    -> CompilationState cd mono i (Maybe (Element mono)))
-> CompilationState cd mono i (Maybe (Element mono))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CompilationState cd mono i (Maybe (Element mono))
-> (Element mono
    -> CompilationState cd mono i (Maybe (Element mono)))
-> Maybe (Element mono)
-> CompilationState cd mono i (Maybe (Element mono))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe (Element mono)
-> CompilationState cd mono i (Maybe (Element mono))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Element mono)
forall a. Maybe a
Nothing) (\itp :: Element mono
itp -> Element mono -> Maybe (Element mono)
forall a. a -> Maybe a
Just Element mono
itp Maybe (Element mono)
-> StateT (cd, mono) (Either (ASTError i)) ()
-> CompilationState cd mono i (Maybe (Element mono))
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (StateT (cd, mono) (Either (ASTError i)) (cd, mono)
forall s (m :: * -> *). MonadState s m => m s
get StateT (cd, mono) (Either (ASTError i)) (cd, mono)
-> ((cd, mono) -> StateT (cd, mono) (Either (ASTError i)) ())
-> StateT (cd, mono) (Either (ASTError i)) ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (cd, mono) -> StateT (cd, mono) (Either (ASTError i)) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put ((cd, mono) -> StateT (cd, mono) (Either (ASTError i)) ())
-> ((cd, mono) -> (cd, mono))
-> (cd, mono)
-> StateT (cd, mono) (Either (ASTError i)) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (cd -> cd) -> (cd, mono) -> (cd, mono)
forall a a' b. (a -> a') -> (a, b) -> (a', b)
first (cd -> Element mono -> cd
`f` Element mono
itp) ((cd, mono) -> (cd, mono))
-> ((cd, mono) -> (cd, mono)) -> (cd, mono) -> (cd, mono)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (mono -> mono) -> (cd, mono) -> (cd, mono)
forall b b' a. (b -> b') -> (a, b) -> (a, b')
second mono -> mono
forall seq. IsSequence seq => seq -> seq
S.tailEx))

{-# INLINE itemsC #-}
-- | `itemsC` consumes at items from input data.
-- Defines information updates by providing a function that
-- accepts the current information and one item to be consumed and returns the information
itemsC :: S.IsSequence mono => (cd -> Element mono -> cd) -> Int -> CompilationState cd mono i (Maybe mono)
itemsC :: (cd -> Element mono -> cd)
-> Int -> CompilationState cd mono i (Maybe mono)
itemsC f :: cd -> Element mono -> cd
f n :: Int
n = do
    [Element mono]
x <- [Maybe (Element mono)] -> [Element mono]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Element mono)] -> [Element mono])
-> StateT (cd, mono) (Either (ASTError i)) [Maybe (Element mono)]
-> StateT (cd, mono) (Either (ASTError i)) [Element mono]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int
-> StateT (cd, mono) (Either (ASTError i)) (Maybe (Element mono))
-> StateT (cd, mono) (Either (ASTError i)) [Maybe (Element mono)]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n ((cd -> Element mono -> cd)
-> StateT (cd, mono) (Either (ASTError i)) (Maybe (Element mono))
forall mono cd i.
IsSequence mono =>
(cd -> Element mono -> cd)
-> CompilationState cd mono i (Maybe (Element mono))
itemC cd -> Element mono -> cd
f)
    Maybe mono -> CompilationState cd mono i (Maybe mono)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe mono -> CompilationState cd mono i (Maybe mono))
-> Maybe mono -> CompilationState cd mono i (Maybe mono)
forall a b. (a -> b) -> a -> b
$ if [Element mono] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Element mono]
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n then mono -> Maybe mono
forall a. a -> Maybe a
Just (mono -> Maybe mono) -> mono -> Maybe mono
forall a b. (a -> b) -> a -> b
$ [Element mono] -> mono
forall seq. IsSequence seq => [Element seq] -> seq
S.pack [Element mono]
x else Maybe mono
forall a. Maybe a
Nothing

{-# INLINE curCD #-}
-- | `curCD` gets current information
curCD :: CompilationState cd mono i cd
curCD :: CompilationState cd mono i cd
curCD = ((cd, mono) -> cd) -> CompilationState cd mono i cd
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (cd, mono) -> cd
forall a b. (a, b) -> a
fst

{-# INLINE itemCWhen #-}
-- | `itemCWhen` consumes an item when the unary function satisfies the given condition.
-- Defines information updates by providing a function that
-- accepts the current information and one item to be consumed and returns the information
itemCWhen :: (MonoFoldable mono, S.IsSequence mono) => (cd -> Element mono -> cd) -> (Element mono -> Bool) -> CompilationState cd mono i (Maybe (Element mono))
itemCWhen :: (cd -> Element mono -> cd)
-> (Element mono -> Bool)
-> CompilationState cd mono i (Maybe (Element mono))
itemCWhen cf :: cd -> Element mono -> cd
cf f :: Element mono -> Bool
f = CompilationState cd mono i (Maybe (Element mono))
forall mono cd i.
MonoFoldable mono =>
CompilationState cd mono i (Maybe (Element mono))
itemP CompilationState cd mono i (Maybe (Element mono))
-> (Maybe (Element mono)
    -> CompilationState cd mono i (Maybe (Element mono)))
-> CompilationState cd mono i (Maybe (Element mono))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CompilationState cd mono i (Maybe (Element mono))
-> (Element mono
    -> CompilationState cd mono i (Maybe (Element mono)))
-> Maybe (Element mono)
-> CompilationState cd mono i (Maybe (Element mono))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe (Element mono)
-> CompilationState cd mono i (Maybe (Element mono))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Element mono)
forall a. Maybe a
Nothing) (CompilationState cd mono i (Maybe (Element mono))
-> CompilationState cd mono i (Maybe (Element mono))
-> Bool
-> CompilationState cd mono i (Maybe (Element mono))
forall a. a -> a -> Bool -> a
bool (Maybe (Element mono)
-> CompilationState cd mono i (Maybe (Element mono))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Element mono)
forall a. Maybe a
Nothing) ((cd -> Element mono -> cd)
-> CompilationState cd mono i (Maybe (Element mono))
forall mono cd i.
IsSequence mono =>
(cd -> Element mono -> cd)
-> CompilationState cd mono i (Maybe (Element mono))
itemC cd -> Element mono -> cd
cf) (Bool -> CompilationState cd mono i (Maybe (Element mono)))
-> (Element mono -> Bool)
-> Element mono
-> CompilationState cd mono i (Maybe (Element mono))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element mono -> Bool
f)

{-# INLINE itemsCWhen #-}
-- | `itemsCWhen` consumes items when the unary function satisfies the given condition.
-- Defines information updates by providing a function that
-- accepts the current information and one item to be consumed and returns the information
itemsCWhen :: (MonoFoldable mono, S.IsSequence mono) => (cd -> Element mono -> cd) -> (Element mono -> Bool) -> CompilationState cd mono i mono
itemsCWhen :: (cd -> Element mono -> cd)
-> (Element mono -> Bool) -> CompilationState cd mono i mono
itemsCWhen cf :: cd -> Element mono -> cd
cf f :: Element mono -> Bool
f = ([Element mono] -> mono)
-> StateT (cd, mono) (Either (ASTError i)) [Element mono]
-> CompilationState cd mono i mono
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Element mono] -> mono
forall seq. IsSequence seq => [Element seq] -> seq
S.pack (StateT (cd, mono) (Either (ASTError i)) [Element mono]
 -> CompilationState cd mono i mono)
-> StateT (cd, mono) (Either (ASTError i)) [Element mono]
-> CompilationState cd mono i mono
forall a b. (a -> b) -> a -> b
$ StateT (cd, mono) (Either (ASTError i)) (Maybe (Element mono))
-> StateT (cd, mono) (Either (ASTError i)) [Element mono]
forall (m :: * -> *) a. Monad m => m (Maybe a) -> m [a]
unfoldM (StateT (cd, mono) (Either (ASTError i)) (Maybe (Element mono))
 -> StateT (cd, mono) (Either (ASTError i)) [Element mono])
-> StateT (cd, mono) (Either (ASTError i)) (Maybe (Element mono))
-> StateT (cd, mono) (Either (ASTError i)) [Element mono]
forall a b. (a -> b) -> a -> b
$ (cd -> Element mono -> cd)
-> (Element mono -> Bool)
-> StateT (cd, mono) (Either (ASTError i)) (Maybe (Element mono))
forall mono cd i.
(MonoFoldable mono, IsSequence mono) =>
(cd -> Element mono -> cd)
-> (Element mono -> Bool)
-> CompilationState cd mono i (Maybe (Element mono))
itemCWhen cd -> Element mono -> cd
cf Element mono -> Bool
f

{-# INLINE isSatisfied #-}
-- | `isSatisfied` returns `True` if the input data satisfies the condition of given unary function, otherwise returns `False`.
isSatisfied :: (mono -> Bool) -> CompilationState cd mono i Bool
isSatisfied :: (mono -> Bool) -> CompilationState cd mono i Bool
isSatisfied f :: mono -> Bool
f = ((cd, mono) -> Bool) -> CompilationState cd mono i Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (mono -> Bool
f (mono -> Bool) -> ((cd, mono) -> mono) -> (cd, mono) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (cd, mono) -> mono
forall a b. (a, b) -> b
snd)