{-# LANGUAGE FlexibleContexts #-}

module CabalGild.Unstable.Type.Condition where

import qualified CabalGild.Unstable.Extra.CharParsing as Parse
import qualified Distribution.Compat.CharParsing as Parse
import qualified Distribution.Parsec as Parsec
import qualified Text.Parsec as P
import qualified Text.Parsec.Expr as PE
import qualified Text.PrettyPrint as PrettyPrint

data Condition a
  = Par (Condition a)
  | Not (Condition a)
  | And (Condition a) (Condition a)
  | Or (Condition a) (Condition a)
  | Lit Bool
  | Var a
  deriving (Condition a -> Condition a -> Bool
(Condition a -> Condition a -> Bool)
-> (Condition a -> Condition a -> Bool) -> Eq (Condition a)
forall a. Eq a => Condition a -> Condition a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Condition a -> Condition a -> Bool
== :: Condition a -> Condition a -> Bool
$c/= :: forall a. Eq a => Condition a -> Condition a -> Bool
/= :: Condition a -> Condition a -> Bool
Eq, Int -> Condition a -> ShowS
[Condition a] -> ShowS
Condition a -> String
(Int -> Condition a -> ShowS)
-> (Condition a -> String)
-> ([Condition a] -> ShowS)
-> Show (Condition a)
forall a. Show a => Int -> Condition a -> ShowS
forall a. Show a => [Condition a] -> ShowS
forall a. Show a => Condition a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Condition a -> ShowS
showsPrec :: Int -> Condition a -> ShowS
$cshow :: forall a. Show a => Condition a -> String
show :: Condition a -> String
$cshowList :: forall a. Show a => [Condition a] -> ShowS
showList :: [Condition a] -> ShowS
Show)

parseCondition :: Parsec.ParsecParser a -> Parsec.ParsecParser (Condition a)
parseCondition :: forall a. ParsecParser a -> ParsecParser (Condition a)
parseCondition ParsecParser a
parseVariable = (CabalSpecVersion
 -> Parsec FieldLineStream [PWarning] (Condition a))
-> ParsecParser (Condition a)
forall a.
(CabalSpecVersion -> Parsec FieldLineStream [PWarning] a)
-> ParsecParser a
Parsec.PP ((CabalSpecVersion
  -> Parsec FieldLineStream [PWarning] (Condition a))
 -> ParsecParser (Condition a))
-> (CabalSpecVersion
    -> Parsec FieldLineStream [PWarning] (Condition a))
-> ParsecParser (Condition a)
forall a b. (a -> b) -> a -> b
$ \CabalSpecVersion
csv -> do
  let operators :: (P.Stream s m Char) => PE.OperatorTable s u m (Condition b)
      operators :: forall s (m :: * -> *) u b.
Stream s m Char =>
OperatorTable s u m (Condition b)
operators =
        [ [ParsecT s u m (Condition b -> Condition b)
-> Operator s u m (Condition b)
forall s u (m :: * -> *) a.
ParsecT s u m (a -> a) -> Operator s u m a
PE.Prefix (Condition b -> Condition b
forall a. Condition a -> Condition a
Not (Condition b -> Condition b)
-> ParsecT s u m Char -> ParsecT s u m (Condition b -> Condition b)
forall a b. a -> ParsecT s u m b -> ParsecT s u m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ParsecT s u m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
Parse.char Char
'!' ParsecT s u m (Condition b -> Condition b)
-> ParsecT s u m () -> ParsecT s u m (Condition b -> Condition b)
forall a b. ParsecT s u m a -> ParsecT s u m b -> ParsecT s u m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT s u m ()
forall (m :: * -> *). CharParsing m => m ()
Parse.spaces)],
          [ParsecT s u m (Condition b -> Condition b -> Condition b)
-> Assoc -> Operator s u m (Condition b)
forall s u (m :: * -> *) a.
ParsecT s u m (a -> a -> a) -> Assoc -> Operator s u m a
PE.Infix (Condition b -> Condition b -> Condition b
forall a. Condition a -> Condition a -> Condition a
And (Condition b -> Condition b -> Condition b)
-> ParsecT s u m String
-> ParsecT s u m (Condition b -> Condition b -> Condition b)
forall a b. a -> ParsecT s u m b -> ParsecT s u m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ParsecT s u m String
forall (m :: * -> *). CharParsing m => String -> m String
Parse.string String
"&&" ParsecT s u m (Condition b -> Condition b -> Condition b)
-> ParsecT s u m ()
-> ParsecT s u m (Condition b -> Condition b -> Condition b)
forall a b. ParsecT s u m a -> ParsecT s u m b -> ParsecT s u m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT s u m ()
forall (m :: * -> *). CharParsing m => m ()
Parse.spaces) Assoc
PE.AssocRight],
          [ParsecT s u m (Condition b -> Condition b -> Condition b)
-> Assoc -> Operator s u m (Condition b)
forall s u (m :: * -> *) a.
ParsecT s u m (a -> a -> a) -> Assoc -> Operator s u m a
PE.Infix (Condition b -> Condition b -> Condition b
forall a. Condition a -> Condition a -> Condition a
Or (Condition b -> Condition b -> Condition b)
-> ParsecT s u m String
-> ParsecT s u m (Condition b -> Condition b -> Condition b)
forall a b. a -> ParsecT s u m b -> ParsecT s u m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ParsecT s u m String
forall (m :: * -> *). CharParsing m => String -> m String
Parse.string String
"||" ParsecT s u m (Condition b -> Condition b -> Condition b)
-> ParsecT s u m ()
-> ParsecT s u m (Condition b -> Condition b -> Condition b)
forall a b. ParsecT s u m a -> ParsecT s u m b -> ParsecT s u m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT s u m ()
forall (m :: * -> *). CharParsing m => m ()
Parse.spaces) Assoc
PE.AssocRight]
        ]
  ParsecT FieldLineStream [PWarning] Identity ()
forall (m :: * -> *). CharParsing m => m ()
Parse.spaces
  OperatorTable FieldLineStream [PWarning] Identity (Condition a)
-> Parsec FieldLineStream [PWarning] (Condition a)
-> Parsec FieldLineStream [PWarning] (Condition a)
forall s (m :: * -> *) t u a.
Stream s m t =>
OperatorTable s u m a -> ParsecT s u m a -> ParsecT s u m a
PE.buildExpressionParser OperatorTable FieldLineStream [PWarning] Identity (Condition a)
forall s (m :: * -> *) u b.
Stream s m Char =>
OperatorTable s u m (Condition b)
operators (Parsec FieldLineStream [PWarning] (Condition a)
 -> Parsec FieldLineStream [PWarning] (Condition a))
-> Parsec FieldLineStream [PWarning] (Condition a)
-> Parsec FieldLineStream [PWarning] (Condition a)
forall a b. (a -> b) -> a -> b
$
    ParsecParser (Condition a)
-> CabalSpecVersion
-> Parsec FieldLineStream [PWarning] (Condition a)
forall a.
ParsecParser a
-> CabalSpecVersion -> Parsec FieldLineStream [PWarning] a
Parsec.unPP
      ( [ParsecParser (Condition a)] -> ParsecParser (Condition a)
forall (m :: * -> *) a. Alternative m => [m a] -> m a
Parse.choice
          [ Condition a -> Condition a
forall a. Condition a -> Condition a
Par (Condition a -> Condition a)
-> ParsecParser (Condition a) -> ParsecParser (Condition a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecParser (Condition a) -> ParsecParser (Condition a)
forall (m :: * -> *) a. CabalParsing m => m a -> m a
Parse.parens (ParsecParser a -> ParsecParser (Condition a)
forall a. ParsecParser a -> ParsecParser (Condition a)
parseCondition ParsecParser a
parseVariable),
            Condition a -> Condition a
forall a. Condition a -> Condition a
Not (Condition a -> Condition a)
-> ParsecParser (Condition a) -> ParsecParser (Condition a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> ParsecParser ()
forall (m :: * -> *). CabalParsing m => String -> m ()
Parse.token String
"!" ParsecParser ()
-> ParsecParser (Condition a) -> ParsecParser (Condition a)
forall a b. ParsecParser a -> ParsecParser b -> ParsecParser b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecParser a -> ParsecParser (Condition a)
forall a. ParsecParser a -> ParsecParser (Condition a)
parseCondition ParsecParser a
parseVariable),
            Bool -> Condition a
forall a. Bool -> Condition a
Lit (Bool -> Condition a)
-> ParsecParser Bool -> ParsecParser (Condition a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecParser Bool -> ParsecParser Bool
forall a. ParsecParser a -> ParsecParser a
forall (m :: * -> *) a. Parsing m => m a -> m a
Parse.try ParsecParser Bool
forall (m :: * -> *). CabalParsing m => m Bool
parseLit,
            a -> Condition a
forall a. a -> Condition a
Var (a -> Condition a) -> ParsecParser a -> ParsecParser (Condition a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecParser a
parseVariable
          ]
      )
      CabalSpecVersion
csv

parseLit :: (Parsec.CabalParsing m) => m Bool
parseLit :: forall (m :: * -> *). CabalParsing m => m Bool
parseLit =
  [m Bool] -> m Bool
forall (m :: * -> *) a. Alternative m => [m a] -> m a
Parse.choice
    [ Bool
True Bool -> m () -> m Bool
forall a b. a -> m b -> m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> m ()
forall (m :: * -> *). CabalParsing m => String -> m ()
Parse.token String
"True",
      Bool
True Bool -> m () -> m Bool
forall a b. a -> m b -> m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> m ()
forall (m :: * -> *). CabalParsing m => String -> m ()
Parse.token String
"true",
      Bool
False Bool -> m () -> m Bool
forall a b. a -> m b -> m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> m ()
forall (m :: * -> *). CabalParsing m => String -> m ()
Parse.token String
"False",
      Bool
False Bool -> m () -> m Bool
forall a b. a -> m b -> m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> m ()
forall (m :: * -> *). CabalParsing m => String -> m ()
Parse.token String
"false"
    ]

prettyCondition :: (a -> PrettyPrint.Doc) -> Condition a -> PrettyPrint.Doc
prettyCondition :: forall a. (a -> Doc) -> Condition a -> Doc
prettyCondition a -> Doc
f Condition a
x =
  case Condition a
x of
    Par Condition a
y -> Doc -> Doc
PrettyPrint.parens ((a -> Doc) -> Condition a -> Doc
forall a. (a -> Doc) -> Condition a -> Doc
prettyCondition a -> Doc
f Condition a
y)
    Not Condition a
y -> Char -> Doc
PrettyPrint.char Char
'!' Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> (a -> Doc) -> Condition a -> Doc
forall a. (a -> Doc) -> Condition a -> Doc
prettyCondition a -> Doc
f Condition a
y
    And Condition a
y Condition a
z ->
      [Doc] -> Doc
PrettyPrint.hsep
        [ (a -> Doc) -> Condition a -> Doc
forall a. (a -> Doc) -> Condition a -> Doc
prettyCondition a -> Doc
f Condition a
y,
          String -> Doc
PrettyPrint.text String
"&&",
          (a -> Doc) -> Condition a -> Doc
forall a. (a -> Doc) -> Condition a -> Doc
prettyCondition a -> Doc
f Condition a
z
        ]
    Or Condition a
y Condition a
z ->
      [Doc] -> Doc
PrettyPrint.hsep
        [ (a -> Doc) -> Condition a -> Doc
forall a. (a -> Doc) -> Condition a -> Doc
prettyCondition a -> Doc
f Condition a
y,
          String -> Doc
PrettyPrint.text String
"||",
          (a -> Doc) -> Condition a -> Doc
forall a. (a -> Doc) -> Condition a -> Doc
prettyCondition a -> Doc
f Condition a
z
        ]
    Lit Bool
y -> String -> Doc
PrettyPrint.text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ if Bool
y then String
"true" else String
"false"
    Var a
y -> a -> Doc
f a
y