module Zinza.Var where

-- | Variable name, possibly a fieldname in the record.
type Var = String

-- | Haskell selector.
type Selector = String

-- | A very simple haskell expression
data HsExpr
    = HsVar Var
    | HsSel HsExpr Var
    | HsApp HsExpr HsExpr

hsVar :: Selector -> HsExpr
hsVar :: Selector -> HsExpr
hsVar = Selector -> HsExpr
HsVar

access :: HsExpr -> Selector -> HsExpr
access :: HsExpr -> Selector -> HsExpr
access = HsExpr -> Selector -> HsExpr
HsSel

accessMaybe :: HsExpr -> Maybe Selector -> HsExpr
accessMaybe :: HsExpr -> Maybe Selector -> HsExpr
accessMaybe HsExpr
e = HsExpr -> (Selector -> HsExpr) -> Maybe Selector -> HsExpr
forall b a. b -> (a -> b) -> Maybe a -> b
maybe HsExpr
e (HsExpr -> Selector -> HsExpr
access HsExpr
e)

displayHsExpr :: HsExpr -> String
displayHsExpr :: HsExpr -> Selector
displayHsExpr HsExpr
expr0 = Int -> HsExpr -> ShowS
go Int
11 HsExpr
expr0 Selector
"" where
    go :: Int -> HsExpr -> ShowS
    go :: Int -> HsExpr -> ShowS
go Int
_ (HsVar Selector
var)
        = Selector -> ShowS
showString Selector
var
    go Int
d (HsSel HsExpr
e Selector
s)
        = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10)
        (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Selector -> ShowS
showString Selector
s
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' '
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> HsExpr -> ShowS
go Int
11 HsExpr
e
    go Int
d (HsApp HsExpr
f HsExpr
x)
        = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10)
        (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Int -> HsExpr -> ShowS
go Int
10 HsExpr
f
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' '
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> HsExpr -> ShowS
go Int
11 HsExpr
x