-- | Allow reading, merging and writing Erlang terms.
module B9.Artifact.Content.ErlangPropList
  ( ErlangPropList (..),
    textToErlangAst,
    stringToErlangAst,
  )
where

import B9.Artifact.Content
import B9.Artifact.Content.AST
import B9.Artifact.Content.ErlTerms
import B9.Artifact.Content.StringTemplate
import B9.Text
import Control.Parallel.Strategies
import Data.Data
import Data.Function
import Data.Hashable
import Data.List (partition, sortBy)
import qualified Data.Text as T
import GHC.Generics (Generic)
import Test.QuickCheck
import Text.Printf

-- | A wrapper type around erlang terms with a Semigroup instance useful for
-- combining sys.config files with OTP-application configurations in a list of
-- the form of a proplist.
newtype ErlangPropList
  = ErlangPropList SimpleErlangTerm
  deriving (ReadPrec [ErlangPropList]
ReadPrec ErlangPropList
Int -> ReadS ErlangPropList
ReadS [ErlangPropList]
(Int -> ReadS ErlangPropList)
-> ReadS [ErlangPropList]
-> ReadPrec ErlangPropList
-> ReadPrec [ErlangPropList]
-> Read ErlangPropList
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ErlangPropList]
$creadListPrec :: ReadPrec [ErlangPropList]
readPrec :: ReadPrec ErlangPropList
$creadPrec :: ReadPrec ErlangPropList
readList :: ReadS [ErlangPropList]
$creadList :: ReadS [ErlangPropList]
readsPrec :: Int -> ReadS ErlangPropList
$creadsPrec :: Int -> ReadS ErlangPropList
Read, ErlangPropList -> ErlangPropList -> Bool
(ErlangPropList -> ErlangPropList -> Bool)
-> (ErlangPropList -> ErlangPropList -> Bool) -> Eq ErlangPropList
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ErlangPropList -> ErlangPropList -> Bool
$c/= :: ErlangPropList -> ErlangPropList -> Bool
== :: ErlangPropList -> ErlangPropList -> Bool
$c== :: ErlangPropList -> ErlangPropList -> Bool
Eq, Int -> ErlangPropList -> ShowS
[ErlangPropList] -> ShowS
ErlangPropList -> String
(Int -> ErlangPropList -> ShowS)
-> (ErlangPropList -> String)
-> ([ErlangPropList] -> ShowS)
-> Show ErlangPropList
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ErlangPropList] -> ShowS
$cshowList :: [ErlangPropList] -> ShowS
show :: ErlangPropList -> String
$cshow :: ErlangPropList -> String
showsPrec :: Int -> ErlangPropList -> ShowS
$cshowsPrec :: Int -> ErlangPropList -> ShowS
Show, Typeable ErlangPropList
DataType
Constr
Typeable ErlangPropList
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> ErlangPropList -> c ErlangPropList)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ErlangPropList)
-> (ErlangPropList -> Constr)
-> (ErlangPropList -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ErlangPropList))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ErlangPropList))
-> ((forall b. Data b => b -> b)
    -> ErlangPropList -> ErlangPropList)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ErlangPropList -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ErlangPropList -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> ErlangPropList -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ErlangPropList -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ErlangPropList -> m ErlangPropList)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ErlangPropList -> m ErlangPropList)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ErlangPropList -> m ErlangPropList)
-> Data ErlangPropList
ErlangPropList -> DataType
ErlangPropList -> Constr
(forall b. Data b => b -> b) -> ErlangPropList -> ErlangPropList
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ErlangPropList -> c ErlangPropList
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ErlangPropList
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) -> ErlangPropList -> u
forall u. (forall d. Data d => d -> u) -> ErlangPropList -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ErlangPropList -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ErlangPropList -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ErlangPropList -> m ErlangPropList
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ErlangPropList -> m ErlangPropList
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ErlangPropList
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ErlangPropList -> c ErlangPropList
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ErlangPropList)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ErlangPropList)
$cErlangPropList :: Constr
$tErlangPropList :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> ErlangPropList -> m ErlangPropList
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ErlangPropList -> m ErlangPropList
gmapMp :: (forall d. Data d => d -> m d)
-> ErlangPropList -> m ErlangPropList
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ErlangPropList -> m ErlangPropList
gmapM :: (forall d. Data d => d -> m d)
-> ErlangPropList -> m ErlangPropList
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ErlangPropList -> m ErlangPropList
gmapQi :: Int -> (forall d. Data d => d -> u) -> ErlangPropList -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ErlangPropList -> u
gmapQ :: (forall d. Data d => d -> u) -> ErlangPropList -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ErlangPropList -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ErlangPropList -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ErlangPropList -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ErlangPropList -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ErlangPropList -> r
gmapT :: (forall b. Data b => b -> b) -> ErlangPropList -> ErlangPropList
$cgmapT :: (forall b. Data b => b -> b) -> ErlangPropList -> ErlangPropList
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ErlangPropList)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ErlangPropList)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c ErlangPropList)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ErlangPropList)
dataTypeOf :: ErlangPropList -> DataType
$cdataTypeOf :: ErlangPropList -> DataType
toConstr :: ErlangPropList -> Constr
$ctoConstr :: ErlangPropList -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ErlangPropList
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ErlangPropList
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ErlangPropList -> c ErlangPropList
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ErlangPropList -> c ErlangPropList
$cp1Data :: Typeable ErlangPropList
Data, Typeable, (forall x. ErlangPropList -> Rep ErlangPropList x)
-> (forall x. Rep ErlangPropList x -> ErlangPropList)
-> Generic ErlangPropList
forall x. Rep ErlangPropList x -> ErlangPropList
forall x. ErlangPropList -> Rep ErlangPropList x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ErlangPropList x -> ErlangPropList
$cfrom :: forall x. ErlangPropList -> Rep ErlangPropList x
Generic)

instance Hashable ErlangPropList

instance NFData ErlangPropList

instance Arbitrary ErlangPropList where
  arbitrary :: Gen ErlangPropList
arbitrary = SimpleErlangTerm -> ErlangPropList
ErlangPropList (SimpleErlangTerm -> ErlangPropList)
-> Gen SimpleErlangTerm -> Gen ErlangPropList
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen SimpleErlangTerm
forall a. Arbitrary a => Gen a
arbitrary

instance Semigroup ErlangPropList where
  (ErlangPropList SimpleErlangTerm
v1) <> :: ErlangPropList -> ErlangPropList -> ErlangPropList
<> (ErlangPropList SimpleErlangTerm
v2) = SimpleErlangTerm -> ErlangPropList
ErlangPropList (SimpleErlangTerm -> SimpleErlangTerm -> SimpleErlangTerm
combine SimpleErlangTerm
v1 SimpleErlangTerm
v2)
    where
      combine :: SimpleErlangTerm -> SimpleErlangTerm -> SimpleErlangTerm
combine (ErlList [SimpleErlangTerm]
l1) (ErlList [SimpleErlangTerm]
l2) = [SimpleErlangTerm] -> SimpleErlangTerm
ErlList ([SimpleErlangTerm]
l1Only [SimpleErlangTerm] -> [SimpleErlangTerm] -> [SimpleErlangTerm]
forall a. Semigroup a => a -> a -> a
<> [SimpleErlangTerm]
merged [SimpleErlangTerm] -> [SimpleErlangTerm] -> [SimpleErlangTerm]
forall a. Semigroup a => a -> a -> a
<> [SimpleErlangTerm]
l2Only)
        where
          l1Only :: [SimpleErlangTerm]
l1Only = [SimpleErlangTerm]
l1NonPairs [SimpleErlangTerm] -> [SimpleErlangTerm] -> [SimpleErlangTerm]
forall a. Semigroup a => a -> a -> a
<> [SimpleErlangTerm]
l1NotL2
          l2Only :: [SimpleErlangTerm]
l2Only = [SimpleErlangTerm]
l2NonPairs [SimpleErlangTerm] -> [SimpleErlangTerm] -> [SimpleErlangTerm]
forall a. Semigroup a => a -> a -> a
<> [SimpleErlangTerm]
l2NotL1
          ([SimpleErlangTerm]
l1Pairs, [SimpleErlangTerm]
l1NonPairs) = (SimpleErlangTerm -> Bool)
-> [SimpleErlangTerm] -> ([SimpleErlangTerm], [SimpleErlangTerm])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition SimpleErlangTerm -> Bool
isPair [SimpleErlangTerm]
l1
          ([SimpleErlangTerm]
l2Pairs, [SimpleErlangTerm]
l2NonPairs) = (SimpleErlangTerm -> Bool)
-> [SimpleErlangTerm] -> ([SimpleErlangTerm], [SimpleErlangTerm])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition SimpleErlangTerm -> Bool
isPair [SimpleErlangTerm]
l2
          merged :: [SimpleErlangTerm]
merged = (SimpleErlangTerm -> SimpleErlangTerm -> SimpleErlangTerm)
-> [SimpleErlangTerm] -> [SimpleErlangTerm] -> [SimpleErlangTerm]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith SimpleErlangTerm -> SimpleErlangTerm -> SimpleErlangTerm
merge [SimpleErlangTerm]
il1 [SimpleErlangTerm]
il2
            where
              merge :: SimpleErlangTerm -> SimpleErlangTerm -> SimpleErlangTerm
merge (ErlTuple [SimpleErlangTerm
_k, SimpleErlangTerm
pv1]) (ErlTuple [SimpleErlangTerm
k, SimpleErlangTerm
pv2]) = [SimpleErlangTerm] -> SimpleErlangTerm
ErlTuple [SimpleErlangTerm
k, SimpleErlangTerm
pv1 SimpleErlangTerm -> SimpleErlangTerm -> SimpleErlangTerm
`combine` SimpleErlangTerm
pv2]
              merge SimpleErlangTerm
_ SimpleErlangTerm
_ = String -> SimpleErlangTerm
forall a. HasCallStack => String -> a
error String
"unreachable"
          ([SimpleErlangTerm]
l1NotL2, [SimpleErlangTerm]
il1, [SimpleErlangTerm]
il2, [SimpleErlangTerm]
l2NotL1) = [SimpleErlangTerm]
-> [SimpleErlangTerm]
-> ([SimpleErlangTerm], [SimpleErlangTerm], [SimpleErlangTerm],
    [SimpleErlangTerm])
-> ([SimpleErlangTerm], [SimpleErlangTerm], [SimpleErlangTerm],
    [SimpleErlangTerm])
partitionByKey [SimpleErlangTerm]
l1Sorted [SimpleErlangTerm]
l2Sorted ([], [], [], [])
            where
              partitionByKey :: [SimpleErlangTerm]
-> [SimpleErlangTerm]
-> ([SimpleErlangTerm], [SimpleErlangTerm], [SimpleErlangTerm],
    [SimpleErlangTerm])
-> ([SimpleErlangTerm], [SimpleErlangTerm], [SimpleErlangTerm],
    [SimpleErlangTerm])
partitionByKey [] [SimpleErlangTerm]
ys ([SimpleErlangTerm]
exs, [SimpleErlangTerm]
cxs, [SimpleErlangTerm]
cys, [SimpleErlangTerm]
eys) = ([SimpleErlangTerm] -> [SimpleErlangTerm]
forall a. [a] -> [a]
reverse [SimpleErlangTerm]
exs, [SimpleErlangTerm] -> [SimpleErlangTerm]
forall a. [a] -> [a]
reverse [SimpleErlangTerm]
cxs, [SimpleErlangTerm] -> [SimpleErlangTerm]
forall a. [a] -> [a]
reverse [SimpleErlangTerm]
cys, [SimpleErlangTerm] -> [SimpleErlangTerm]
forall a. [a] -> [a]
reverse [SimpleErlangTerm]
eys [SimpleErlangTerm] -> [SimpleErlangTerm] -> [SimpleErlangTerm]
forall a. Semigroup a => a -> a -> a
<> [SimpleErlangTerm]
ys)
              partitionByKey [SimpleErlangTerm]
xs [] ([SimpleErlangTerm]
exs, [SimpleErlangTerm]
cxs, [SimpleErlangTerm]
cys, [SimpleErlangTerm]
eys) = ([SimpleErlangTerm] -> [SimpleErlangTerm]
forall a. [a] -> [a]
reverse [SimpleErlangTerm]
exs [SimpleErlangTerm] -> [SimpleErlangTerm] -> [SimpleErlangTerm]
forall a. Semigroup a => a -> a -> a
<> [SimpleErlangTerm]
xs, [SimpleErlangTerm] -> [SimpleErlangTerm]
forall a. [a] -> [a]
reverse [SimpleErlangTerm]
cxs, [SimpleErlangTerm] -> [SimpleErlangTerm]
forall a. [a] -> [a]
reverse [SimpleErlangTerm]
cys, [SimpleErlangTerm] -> [SimpleErlangTerm]
forall a. [a] -> [a]
reverse [SimpleErlangTerm]
eys)
              partitionByKey (SimpleErlangTerm
x : [SimpleErlangTerm]
xs) (SimpleErlangTerm
y : [SimpleErlangTerm]
ys) ([SimpleErlangTerm]
exs, [SimpleErlangTerm]
cxs, [SimpleErlangTerm]
cys, [SimpleErlangTerm]
eys)
                | SimpleErlangTerm -> SimpleErlangTerm -> Bool
equalKey SimpleErlangTerm
x SimpleErlangTerm
y = [SimpleErlangTerm]
-> [SimpleErlangTerm]
-> ([SimpleErlangTerm], [SimpleErlangTerm], [SimpleErlangTerm],
    [SimpleErlangTerm])
-> ([SimpleErlangTerm], [SimpleErlangTerm], [SimpleErlangTerm],
    [SimpleErlangTerm])
partitionByKey [SimpleErlangTerm]
xs [SimpleErlangTerm]
ys ([SimpleErlangTerm]
exs, SimpleErlangTerm
x SimpleErlangTerm -> [SimpleErlangTerm] -> [SimpleErlangTerm]
forall a. a -> [a] -> [a]
: [SimpleErlangTerm]
cxs, SimpleErlangTerm
y SimpleErlangTerm -> [SimpleErlangTerm] -> [SimpleErlangTerm]
forall a. a -> [a] -> [a]
: [SimpleErlangTerm]
cys, [SimpleErlangTerm]
eys)
                | SimpleErlangTerm
x SimpleErlangTerm -> SimpleErlangTerm -> Bool
`keyLessThan` SimpleErlangTerm
y = [SimpleErlangTerm]
-> [SimpleErlangTerm]
-> ([SimpleErlangTerm], [SimpleErlangTerm], [SimpleErlangTerm],
    [SimpleErlangTerm])
-> ([SimpleErlangTerm], [SimpleErlangTerm], [SimpleErlangTerm],
    [SimpleErlangTerm])
partitionByKey [SimpleErlangTerm]
xs (SimpleErlangTerm
y SimpleErlangTerm -> [SimpleErlangTerm] -> [SimpleErlangTerm]
forall a. a -> [a] -> [a]
: [SimpleErlangTerm]
ys) (SimpleErlangTerm
x SimpleErlangTerm -> [SimpleErlangTerm] -> [SimpleErlangTerm]
forall a. a -> [a] -> [a]
: [SimpleErlangTerm]
exs, [SimpleErlangTerm]
cxs, [SimpleErlangTerm]
cys, [SimpleErlangTerm]
eys)
                | Bool
otherwise = [SimpleErlangTerm]
-> [SimpleErlangTerm]
-> ([SimpleErlangTerm], [SimpleErlangTerm], [SimpleErlangTerm],
    [SimpleErlangTerm])
-> ([SimpleErlangTerm], [SimpleErlangTerm], [SimpleErlangTerm],
    [SimpleErlangTerm])
partitionByKey (SimpleErlangTerm
x SimpleErlangTerm -> [SimpleErlangTerm] -> [SimpleErlangTerm]
forall a. a -> [a] -> [a]
: [SimpleErlangTerm]
xs) [SimpleErlangTerm]
ys ([SimpleErlangTerm]
exs, [SimpleErlangTerm]
cxs, [SimpleErlangTerm]
cys, SimpleErlangTerm
y SimpleErlangTerm -> [SimpleErlangTerm] -> [SimpleErlangTerm]
forall a. a -> [a] -> [a]
: [SimpleErlangTerm]
eys)
              l1Sorted :: [SimpleErlangTerm]
l1Sorted = [SimpleErlangTerm] -> [SimpleErlangTerm]
sortByKey [SimpleErlangTerm]
l1Pairs
              l2Sorted :: [SimpleErlangTerm]
l2Sorted = [SimpleErlangTerm] -> [SimpleErlangTerm]
sortByKey [SimpleErlangTerm]
l2Pairs
          sortByKey :: [SimpleErlangTerm] -> [SimpleErlangTerm]
sortByKey = (SimpleErlangTerm -> SimpleErlangTerm -> Ordering)
-> [SimpleErlangTerm] -> [SimpleErlangTerm]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (SimpleErlangTerm -> SimpleErlangTerm -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (SimpleErlangTerm -> SimpleErlangTerm -> Ordering)
-> (SimpleErlangTerm -> SimpleErlangTerm)
-> SimpleErlangTerm
-> SimpleErlangTerm
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` SimpleErlangTerm -> SimpleErlangTerm
getKey)
          keyLessThan :: SimpleErlangTerm -> SimpleErlangTerm -> Bool
keyLessThan = SimpleErlangTerm -> SimpleErlangTerm -> Bool
forall a. Ord a => a -> a -> Bool
(<) (SimpleErlangTerm -> SimpleErlangTerm -> Bool)
-> (SimpleErlangTerm -> SimpleErlangTerm)
-> SimpleErlangTerm
-> SimpleErlangTerm
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` SimpleErlangTerm -> SimpleErlangTerm
getKey
          equalKey :: SimpleErlangTerm -> SimpleErlangTerm -> Bool
equalKey = SimpleErlangTerm -> SimpleErlangTerm -> Bool
forall a. Eq a => a -> a -> Bool
(==) (SimpleErlangTerm -> SimpleErlangTerm -> Bool)
-> (SimpleErlangTerm -> SimpleErlangTerm)
-> SimpleErlangTerm
-> SimpleErlangTerm
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` SimpleErlangTerm -> SimpleErlangTerm
getKey
          getKey :: SimpleErlangTerm -> SimpleErlangTerm
getKey (ErlTuple (SimpleErlangTerm
x : [SimpleErlangTerm]
_)) = SimpleErlangTerm
x
          getKey SimpleErlangTerm
x = SimpleErlangTerm
x
          isPair :: SimpleErlangTerm -> Bool
isPair (ErlTuple [SimpleErlangTerm
_, SimpleErlangTerm
_]) = Bool
True
          isPair SimpleErlangTerm
_ = Bool
False
      combine (ErlList [SimpleErlangTerm]
pl1) SimpleErlangTerm
t2 = [SimpleErlangTerm] -> SimpleErlangTerm
ErlList ([SimpleErlangTerm]
pl1 [SimpleErlangTerm] -> [SimpleErlangTerm] -> [SimpleErlangTerm]
forall a. Semigroup a => a -> a -> a
<> [SimpleErlangTerm
t2])
      combine SimpleErlangTerm
t1 (ErlList [SimpleErlangTerm]
pl2) = [SimpleErlangTerm] -> SimpleErlangTerm
ErlList ([SimpleErlangTerm
t1] [SimpleErlangTerm] -> [SimpleErlangTerm] -> [SimpleErlangTerm]
forall a. Semigroup a => a -> a -> a
<> [SimpleErlangTerm]
pl2)
      combine SimpleErlangTerm
t1 SimpleErlangTerm
t2 = [SimpleErlangTerm] -> SimpleErlangTerm
ErlList [SimpleErlangTerm
t1, SimpleErlangTerm
t2]

instance Textual ErlangPropList where
  parseFromText :: Text -> Either String ErlangPropList
parseFromText Text
txt = do
    Text
str <- Text -> Either String Text
forall a. (Textual a, HasCallStack) => Text -> Either String a
parseFromText Text
txt
    SimpleErlangTerm
t <- String -> Text -> Either String SimpleErlangTerm
parseErlTerm String
"" Text
str
    ErlangPropList -> Either String ErlangPropList
forall (m :: * -> *) a. Monad m => a -> m a
return (SimpleErlangTerm -> ErlangPropList
ErlangPropList SimpleErlangTerm
t)
  renderToText :: ErlangPropList -> Either String Text
renderToText (ErlangPropList SimpleErlangTerm
t) = Text -> Either String Text
forall a. (Textual a, HasCallStack) => a -> Either String Text
renderToText (SimpleErlangTerm -> Text
renderErlTerm SimpleErlangTerm
t)

instance FromAST ErlangPropList where
  fromAST :: AST c ErlangPropList -> Eff e ErlangPropList
fromAST (AST ErlangPropList
a) = ErlangPropList -> Eff e ErlangPropList
forall (f :: * -> *) a. Applicative f => a -> f a
pure ErlangPropList
a
  fromAST (ASTObj [(String, AST c ErlangPropList)]
pairs) = SimpleErlangTerm -> ErlangPropList
ErlangPropList (SimpleErlangTerm -> ErlangPropList)
-> ([SimpleErlangTerm] -> SimpleErlangTerm)
-> [SimpleErlangTerm]
-> ErlangPropList
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SimpleErlangTerm] -> SimpleErlangTerm
ErlList ([SimpleErlangTerm] -> ErlangPropList)
-> Eff e [SimpleErlangTerm] -> Eff e ErlangPropList
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((String, AST c ErlangPropList) -> Eff e SimpleErlangTerm)
-> [(String, AST c ErlangPropList)] -> Eff e [SimpleErlangTerm]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (String, AST c ErlangPropList) -> Eff e SimpleErlangTerm
forall (e :: [* -> *]) c.
(SetMember Lift (Lift IO) e, ToContentGenerator c,
 FindElem (Exc SomeException) e, FindElem (Reader Environment) e,
 FindElem (Reader BuildInfo) e, FindElem (Reader RepoCache) e,
 FindElem (Reader SelectedRemoteRepo) e,
 FindElem (Reader B9Config) e, FindElem (Reader Logger) e,
 MonadBaseControl IO (Eff e)) =>
(String, AST c ErlangPropList) -> Eff e SimpleErlangTerm
makePair [(String, AST c ErlangPropList)]
pairs
    where
      makePair :: (String, AST c ErlangPropList) -> Eff e SimpleErlangTerm
makePair (String
k, AST c ErlangPropList
ast) = do
        (ErlangPropList SimpleErlangTerm
second) <- AST c ErlangPropList -> Eff e ErlangPropList
forall a (e :: [* -> *]) c.
(FromAST a, IsB9 e, ToContentGenerator c) =>
AST c a -> Eff e a
fromAST AST c ErlangPropList
ast
        SimpleErlangTerm -> Eff e SimpleErlangTerm
forall (m :: * -> *) a. Monad m => a -> m a
return (SimpleErlangTerm -> Eff e SimpleErlangTerm)
-> SimpleErlangTerm -> Eff e SimpleErlangTerm
forall a b. (a -> b) -> a -> b
$ [SimpleErlangTerm] -> SimpleErlangTerm
ErlTuple [String -> SimpleErlangTerm
ErlAtom String
k, SimpleErlangTerm
second]
  fromAST (ASTArr [AST c ErlangPropList]
xs) =
    SimpleErlangTerm -> ErlangPropList
ErlangPropList (SimpleErlangTerm -> ErlangPropList)
-> ([SimpleErlangTerm] -> SimpleErlangTerm)
-> [SimpleErlangTerm]
-> ErlangPropList
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SimpleErlangTerm] -> SimpleErlangTerm
ErlList
      ([SimpleErlangTerm] -> ErlangPropList)
-> Eff e [SimpleErlangTerm] -> Eff e ErlangPropList
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (AST c ErlangPropList -> Eff e SimpleErlangTerm)
-> [AST c ErlangPropList] -> Eff e [SimpleErlangTerm]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM
        ( \AST c ErlangPropList
x -> do
            (ErlangPropList SimpleErlangTerm
x') <- AST c ErlangPropList -> Eff e ErlangPropList
forall a (e :: [* -> *]) c.
(FromAST a, IsB9 e, ToContentGenerator c) =>
AST c a -> Eff e a
fromAST AST c ErlangPropList
x
            SimpleErlangTerm -> Eff e SimpleErlangTerm
forall (m :: * -> *) a. Monad m => a -> m a
return SimpleErlangTerm
x'
        )
        [AST c ErlangPropList]
xs
  fromAST (ASTString String
s) = ErlangPropList -> Eff e ErlangPropList
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ErlangPropList -> Eff e ErlangPropList)
-> ErlangPropList -> Eff e ErlangPropList
forall a b. (a -> b) -> a -> b
$ SimpleErlangTerm -> ErlangPropList
ErlangPropList (SimpleErlangTerm -> ErlangPropList)
-> SimpleErlangTerm -> ErlangPropList
forall a b. (a -> b) -> a -> b
$ String -> SimpleErlangTerm
ErlString String
s
  fromAST (ASTInt Int
i) = ErlangPropList -> Eff e ErlangPropList
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ErlangPropList -> Eff e ErlangPropList)
-> ErlangPropList -> Eff e ErlangPropList
forall a b. (a -> b) -> a -> b
$ SimpleErlangTerm -> ErlangPropList
ErlangPropList (SimpleErlangTerm -> ErlangPropList)
-> SimpleErlangTerm -> ErlangPropList
forall a b. (a -> b) -> a -> b
$ String -> SimpleErlangTerm
ErlString (Int -> String
forall a. Show a => a -> String
show Int
i)
  fromAST (ASTEmbed c
c) = SimpleErlangTerm -> ErlangPropList
ErlangPropList (SimpleErlangTerm -> ErlangPropList)
-> (Text -> SimpleErlangTerm) -> Text -> ErlangPropList
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> SimpleErlangTerm
ErlString (String -> SimpleErlangTerm)
-> (Text -> String) -> Text -> SimpleErlangTerm
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> ErlangPropList) -> Eff e Text -> Eff e ErlangPropList
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> c -> Eff e Text
forall c (e :: [* -> *]).
(ToContentGenerator c, HasCallStack, IsB9 e) =>
c -> Eff e Text
toContentGenerator c
c
  fromAST (ASTMerge []) = String -> Eff e ErlangPropList
forall a. HasCallStack => String -> a
error String
"ASTMerge MUST NOT be used with an empty list!"
  fromAST (ASTMerge [AST c ErlangPropList]
asts) = (ErlangPropList -> ErlangPropList -> ErlangPropList)
-> [ErlangPropList] -> ErlangPropList
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 ErlangPropList -> ErlangPropList -> ErlangPropList
forall a. Semigroup a => a -> a -> a
(<>) ([ErlangPropList] -> ErlangPropList)
-> Eff e [ErlangPropList] -> Eff e ErlangPropList
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (AST c ErlangPropList -> Eff e ErlangPropList)
-> [AST c ErlangPropList] -> Eff e [ErlangPropList]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM AST c ErlangPropList -> Eff e ErlangPropList
forall a (e :: [* -> *]) c.
(FromAST a, IsB9 e, ToContentGenerator c) =>
AST c a -> Eff e a
fromAST [AST c ErlangPropList]
asts
  fromAST (ASTParse src :: SourceFile
src@(Source SourceFileConversion
_ String
srcPath)) = do
    Text
c <- SourceFile -> Eff e Text
forall (e :: [* -> *]).
(MonadIO (Eff e),
 '[Exc SomeException, Reader Environment] <:: e) =>
SourceFile -> Eff e Text
readTemplateFile SourceFile
src
    case String -> Text -> Either String ErlangPropList
forall a.
(HasCallStack, Textual a) =>
String -> Text -> Either String a
parseFromTextWithErrorMessage String
srcPath Text
c of
      Right ErlangPropList
s -> ErlangPropList -> Eff e ErlangPropList
forall (m :: * -> *) a. Monad m => a -> m a
return ErlangPropList
s
      Left String
e -> String -> Eff e ErlangPropList
forall a. HasCallStack => String -> a
error (String -> String -> ShowS
forall r. PrintfType r => String -> r
printf String
"could not parse erlang source file: '%s'\n%s\n" String
srcPath String
e)

-- * Misc. utilities

-- | Parse a text containing an @Erlang@ expression ending with a @.@ and Return
-- an 'AST'.
--
-- @since 0.5.67
textToErlangAst :: Text -> AST c ErlangPropList
textToErlangAst :: Text -> AST c ErlangPropList
textToErlangAst Text
txt =
  (String -> AST c ErlangPropList)
-> (ErlangPropList -> AST c ErlangPropList)
-> Either String ErlangPropList
-> AST c ErlangPropList
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
    (String -> AST c ErlangPropList
forall a. HasCallStack => String -> a
error (String -> AST c ErlangPropList)
-> ShowS -> String -> AST c ErlangPropList
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text -> String
forall a. (Textual a, HasCallStack) => Text -> a
unsafeParseFromText Text
txt String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n:  ") String -> ShowS
forall a. [a] -> [a] -> [a]
++))
    ErlangPropList -> AST c ErlangPropList
forall c a. a -> AST c a
AST
    (String -> Text -> Either String ErlangPropList
forall a.
(HasCallStack, Textual a) =>
String -> Text -> Either String a
parseFromTextWithErrorMessage String
"textToErlangAst" Text
txt)

-- | Parse a string containing an @Erlang@ expression ending with a @.@ and Return
-- an 'AST'.
--
-- @since 0.5.67
stringToErlangAst :: String -> AST c ErlangPropList
stringToErlangAst :: String -> AST c ErlangPropList
stringToErlangAst = Text -> AST c ErlangPropList
forall c. Text -> AST c ErlangPropList
textToErlangAst (Text -> AST c ErlangPropList)
-> (String -> Text) -> String -> AST c ErlangPropList
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a. (Textual a, HasCallStack) => a -> Text
unsafeRenderToText