{-# LANGUAGE GADTs, KindSignatures, TypeOperators #-}
data InvoiceLine = InvoiceLine
{ ilDescription :: String
, ilQuantity :: Int
, ilAmount :: Int
}
data (:->:) :: * -> * -> * where
Sum :: e :->: Int -> [e] :->: Int
(:-:) :: e :->: Int -> e :->: Int -> e :->: Int
(:*:) :: e :->: Int -> e :->: Int -> e :->: Int
Constant :: Int -> e :->: Int
ILQuantity :: InvoiceLine :->: Int
ILAmount :: InvoiceLine :->: Int
toSQL :: (e :->: a) -> String
toSQL (Sum xs) = "coalesce(sum(" ++ toSQL xs ++ "), 0)"
toSQL (a :-: b) = "(" ++ toSQL a ++ ") - (" ++ toSQL b ++ ")"
toSQL (a :*: b) = "(" ++ toSQL a ++ ") * (" ++ toSQL b ++ ")"
toSQL (Constant n) = show n
toSQL ILQuantity = "invoice_lines.quantity"
toSQL ILAmount = "invoice_lines.amount"
toHaskell :: (e :->: a) -> (e -> a)
toHaskell (Sum xs) e = sum (map (toHaskell xs) e)
toHaskell (a :-: b) e = toHaskell a e - toHaskell b e
toHaskell (a :*: b) e = toHaskell a e * toHaskell b e
toHaskell (Constant n) _ = n
toHaskell ILQuantity e = ilQuantity e
toHaskell ILAmount e = ilAmount e
invoiceLineTotal :: InvoiceLine :->: Int
invoiceLineTotal = ILQuantity :*: (ILAmount :-: Constant 50)
invoiceTotal :: [InvoiceLine] :->: Int
invoiceTotal = Sum invoiceLineTotal
main :: IO ()
main = do
let computation = invoiceTotal
putStrLn $ toSQL computation
print $ toHaskell computation [InvoiceLine "Banana" 2 99, InvoiceLine "Pineapple" 1 139]
