module Hix.Data.NixExpr where

data ExprAttr =
  ExprAttr {
    ExprAttr -> Text
name :: Text,
    ExprAttr -> Expr
value :: Expr
  }
  |
  ExprAttrNil
  deriving stock (ExprAttr -> ExprAttr -> Bool
(ExprAttr -> ExprAttr -> Bool)
-> (ExprAttr -> ExprAttr -> Bool) -> Eq ExprAttr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ExprAttr -> ExprAttr -> Bool
== :: ExprAttr -> ExprAttr -> Bool
$c/= :: ExprAttr -> ExprAttr -> Bool
/= :: ExprAttr -> ExprAttr -> Bool
Eq, Int -> ExprAttr -> ShowS
[ExprAttr] -> ShowS
ExprAttr -> String
(Int -> ExprAttr -> ShowS)
-> (ExprAttr -> String) -> ([ExprAttr] -> ShowS) -> Show ExprAttr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExprAttr -> ShowS
showsPrec :: Int -> ExprAttr -> ShowS
$cshow :: ExprAttr -> String
show :: ExprAttr -> String
$cshowList :: [ExprAttr] -> ShowS
showList :: [ExprAttr] -> ShowS
Show, (forall x. ExprAttr -> Rep ExprAttr x)
-> (forall x. Rep ExprAttr x -> ExprAttr) -> Generic ExprAttr
forall x. Rep ExprAttr x -> ExprAttr
forall x. ExprAttr -> Rep ExprAttr x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ExprAttr -> Rep ExprAttr x
from :: forall x. ExprAttr -> Rep ExprAttr x
$cto :: forall x. Rep ExprAttr x -> ExprAttr
to :: forall x. Rep ExprAttr x -> ExprAttr
Generic)

data Expr =
  ExprNull
  |
  ExprString Text
  |
  ExprLit Text
  |
  ExprList [Expr]
  |
  ExprAttrs [ExprAttr]
  |
  ExprPrefix Text Expr
  deriving stock (Expr -> Expr -> Bool
(Expr -> Expr -> Bool) -> (Expr -> Expr -> Bool) -> Eq Expr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Expr -> Expr -> Bool
== :: Expr -> Expr -> Bool
$c/= :: Expr -> Expr -> Bool
/= :: Expr -> Expr -> Bool
Eq, Int -> Expr -> ShowS
[Expr] -> ShowS
Expr -> String
(Int -> Expr -> ShowS)
-> (Expr -> String) -> ([Expr] -> ShowS) -> Show Expr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Expr -> ShowS
showsPrec :: Int -> Expr -> ShowS
$cshow :: Expr -> String
show :: Expr -> String
$cshowList :: [Expr] -> ShowS
showList :: [Expr] -> ShowS
Show, (forall x. Expr -> Rep Expr x)
-> (forall x. Rep Expr x -> Expr) -> Generic Expr
forall x. Rep Expr x -> Expr
forall x. Expr -> Rep Expr x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Expr -> Rep Expr x
from :: forall x. Expr -> Rep Expr x
$cto :: forall x. Rep Expr x -> Expr
to :: forall x. Rep Expr x -> Expr
Generic)

exprShow :: Show a => a -> Expr
exprShow :: forall a. Show a => a -> Expr
exprShow =
  Text -> Expr
ExprLit (Text -> Expr) -> (a -> Text) -> a -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Text
forall b a. (Show a, IsString b) => a -> b
show

exprBool :: Bool -> Expr
exprBool :: Bool -> Expr
exprBool =
  Text -> Expr
ExprLit (Text -> Expr) -> (Bool -> Text) -> Bool -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
    Bool
True -> Text
"true"
    Bool
False -> Text
"false"

newtype ViaPretty a =
  ViaPretty  a
  deriving stock (ViaPretty a -> ViaPretty a -> Bool
(ViaPretty a -> ViaPretty a -> Bool)
-> (ViaPretty a -> ViaPretty a -> Bool) -> Eq (ViaPretty a)
forall a. Eq a => ViaPretty a -> ViaPretty a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => ViaPretty a -> ViaPretty a -> Bool
== :: ViaPretty a -> ViaPretty a -> Bool
$c/= :: forall a. Eq a => ViaPretty a -> ViaPretty a -> Bool
/= :: ViaPretty a -> ViaPretty a -> Bool
Eq, Int -> ViaPretty a -> ShowS
[ViaPretty a] -> ShowS
ViaPretty a -> String
(Int -> ViaPretty a -> ShowS)
-> (ViaPretty a -> String)
-> ([ViaPretty a] -> ShowS)
-> Show (ViaPretty a)
forall a. Show a => Int -> ViaPretty a -> ShowS
forall a. Show a => [ViaPretty a] -> ShowS
forall a. Show a => ViaPretty a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> ViaPretty a -> ShowS
showsPrec :: Int -> ViaPretty a -> ShowS
$cshow :: forall a. Show a => ViaPretty a -> String
show :: ViaPretty a -> String
$cshowList :: forall a. Show a => [ViaPretty a] -> ShowS
showList :: [ViaPretty a] -> ShowS
Show, (forall x. ViaPretty a -> Rep (ViaPretty a) x)
-> (forall x. Rep (ViaPretty a) x -> ViaPretty a)
-> Generic (ViaPretty a)
forall x. Rep (ViaPretty a) x -> ViaPretty a
forall x. ViaPretty a -> Rep (ViaPretty a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (ViaPretty a) x -> ViaPretty a
forall a x. ViaPretty a -> Rep (ViaPretty a) x
$cfrom :: forall a x. ViaPretty a -> Rep (ViaPretty a) x
from :: forall x. ViaPretty a -> Rep (ViaPretty a) x
$cto :: forall a x. Rep (ViaPretty a) x -> ViaPretty a
to :: forall x. Rep (ViaPretty a) x -> ViaPretty a
Generic)