module Zinza.Type (
    Ty (..),
    tyUnit,
    displayTy,
    ) where

import qualified Data.Map as Map

import Zinza.Var

-- $setup
-- >>> import Zinza
-- >>> import Data.Proxy (Proxy (..))

-- | Zinza types.
--
-- The 'selector's tell how the Haskell value can be
-- converted to primitive value. E.g.
--
-- >>> toType (Proxy :: Proxy Char)
-- TyString (Just "return")
--
-- Here, 'return' converts 'Char' to 'String'.
--
data Ty
    = TyBool                                 -- ^ boolean
    | TyString (Maybe Selector)              -- ^ string
    | TyList (Maybe Selector) Ty             -- ^ lists
    | TyRecord (Map.Map Var (Selector, Ty))    -- ^ records
    | TyFun Ty Ty                            -- ^ functions
  deriving (Ty -> Ty -> Bool
(Ty -> Ty -> Bool) -> (Ty -> Ty -> Bool) -> Eq Ty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Ty -> Ty -> Bool
== :: Ty -> Ty -> Bool
$c/= :: Ty -> Ty -> Bool
/= :: Ty -> Ty -> Bool
Eq, Eq Ty
Eq Ty =>
(Ty -> Ty -> Ordering)
-> (Ty -> Ty -> Bool)
-> (Ty -> Ty -> Bool)
-> (Ty -> Ty -> Bool)
-> (Ty -> Ty -> Bool)
-> (Ty -> Ty -> Ty)
-> (Ty -> Ty -> Ty)
-> Ord Ty
Ty -> Ty -> Bool
Ty -> Ty -> Ordering
Ty -> Ty -> Ty
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Ty -> Ty -> Ordering
compare :: Ty -> Ty -> Ordering
$c< :: Ty -> Ty -> Bool
< :: Ty -> Ty -> Bool
$c<= :: Ty -> Ty -> Bool
<= :: Ty -> Ty -> Bool
$c> :: Ty -> Ty -> Bool
> :: Ty -> Ty -> Bool
$c>= :: Ty -> Ty -> Bool
>= :: Ty -> Ty -> Bool
$cmax :: Ty -> Ty -> Ty
max :: Ty -> Ty -> Ty
$cmin :: Ty -> Ty -> Ty
min :: Ty -> Ty -> Ty
Ord, Int -> Ty -> ShowS
[Ty] -> ShowS
Ty -> Selector
(Int -> Ty -> ShowS)
-> (Ty -> Selector) -> ([Ty] -> ShowS) -> Show Ty
forall a.
(Int -> a -> ShowS) -> (a -> Selector) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Ty -> ShowS
showsPrec :: Int -> Ty -> ShowS
$cshow :: Ty -> Selector
show :: Ty -> Selector
$cshowList :: [Ty] -> ShowS
showList :: [Ty] -> ShowS
Show)

-- | A record without fields is a unit type. Think of zero-field tuple: @()@.
tyUnit :: Ty
tyUnit :: Ty
tyUnit = Map Selector (Selector, Ty) -> Ty
TyRecord Map Selector (Selector, Ty)
forall k a. Map k a
Map.empty

-- | Pretty print 'Ty'.
displayTy :: Ty -> String
displayTy :: Ty -> Selector
displayTy Ty
ty = Int -> Ty -> ShowS
go Int
0 Ty
ty Selector
"" where
    go :: Int -> Ty -> ShowS
    go :: Int -> Ty -> ShowS
go Int
_ Ty
TyBool       = Selector -> ShowS
showString Selector
"Bool"
    go Int
_ (TyString Maybe Selector
_) = Selector -> ShowS
showString Selector
"String"
    go Int
_ (TyList Maybe Selector
_ Ty
t) = Char -> ShowS
showChar Char
'[' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Ty -> ShowS
go Int
0 Ty
t ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
']'
    go Int
_ (TyRecord Map Selector (Selector, Ty)
m) = case Map Selector (Selector, Ty) -> [(Selector, (Selector, Ty))]
forall k a. Map k a -> [(k, a)]
Map.toList Map Selector (Selector, Ty)
m of
        []            -> Selector -> ShowS
showString Selector
"{}"
        ((Selector
n,(Selector
_,Ty
t)) : [(Selector, (Selector, Ty))]
nts) -> (ShowS -> (Selector, (Selector, Ty)) -> ShowS)
-> ShowS -> [(Selector, (Selector, Ty))] -> ShowS
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl
            (\ShowS
acc (Selector
n',(Selector
_,Ty
t')) -> ShowS
acc ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Selector -> ShowS
showString Selector
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Selector -> Ty -> ShowS
showPair Selector
n' Ty
t')
            (Char -> ShowS
showChar Char
'{' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Selector -> Ty -> ShowS
showPair Selector
n Ty
t)
            [(Selector, (Selector, Ty))]
nts
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'}'
    go Int
d (TyFun Ty
a Ty
b) = 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 -> Ty -> ShowS
go Int
11 Ty
a ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Selector -> ShowS
showString Selector
" -> " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Ty -> ShowS
go Int
10 Ty
b

    showPair :: Selector -> Ty -> ShowS
showPair Selector
n Ty
t = Selector -> ShowS
showString Selector
n ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Selector -> ShowS
showString Selector
": " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Ty -> ShowS
go Int
0 Ty
t