{-# language OverloadedStrings #-}
{-# language RecordWildCards #-}

module FastDownward.SAS.State ( State(..), toSAS ) where

import Data.Sequence ( Seq )
import qualified Data.Text.Lazy.Builder
import FastDownward.SAS.DomainIndex ( DomainIndex )
import qualified FastDownward.SAS.DomainIndex as DomainIndex


newtype State =
  State { State -> Seq DomainIndex
initialValues :: Seq DomainIndex }
  deriving
    ( Int -> State -> ShowS
[State] -> ShowS
State -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [State] -> ShowS
$cshowList :: [State] -> ShowS
show :: State -> String
$cshow :: State -> String
showsPrec :: Int -> State -> ShowS
$cshowsPrec :: Int -> State -> ShowS
Show )


toSAS :: State -> Data.Text.Lazy.Builder.Builder
toSAS :: State -> Builder
toSAS State{Seq DomainIndex
initialValues :: Seq DomainIndex
initialValues :: State -> Seq DomainIndex
..} =
     Builder
"begin_state\n"
  forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ( \DomainIndex
x -> DomainIndex -> Builder
DomainIndex.toSAS DomainIndex
x forall a. Semigroup a => a -> a -> a
<> Builder
"\n" ) Seq DomainIndex
initialValues
  forall a. Semigroup a => a -> a -> a
<> Builder
"end_state"