…that you should not mix apples and oranges…
module Fruit1 where
data Fruit
= Apples Integer
| Oranges Integer
deriving Show
mix :: Fruit -> Fruit -> Fruit
mix (Apples m) (Apples n) = Apples (m + n)
mix (Oranges m) (Oranges n) = Oranges (m + n)
mix _ _ = error "Not gonna happen!"
main :: IO ()
main = do
print $ Apples 4 `mix` Apples 5
print $ Oranges 4 `mix` Oranges 5
print $ Apples 4 `mix` Oranges 5 -- :-(
module Fruit2 where
newtype Apples = Apples Integer deriving Show
newtype Oranges = Oranges Integer deriving Show
mixApples :: Apples -> Apples -> Apples
Apples m `mixApples` Apples n = Apples (m + n)
mixOranges :: Oranges -> Oranges -> Oranges
Oranges m `mixOranges` Oranges n = Oranges (m + n)
main :: IO ()
main = do
print $ Apples 4 `mixApples` Apples 5
print $ Oranges 4 `mixOranges` Oranges 5
-- print $ Apples 4 `mixApples` Oranges 5
module Fruit2THHelper (genFruit) where
import Language.Haskell.TH
genFruit :: String -> Q [Dec]
genFruit fruit_name' = do
let fun_name = mkName ("mix" ++ fruit_name')
fruit_name = mkName fruit_name'
m <- newName "m"
n <- newName "n"
return
[ NewtypeD [] fruit_name []
(NormalC fruit_name [(NotStrict, ConT (mkName "Integer"))])
[mkName "Show"]
, SigD fun_name (ArrowT `AppT` ConT fruit_name
`AppT` (ArrowT `AppT` ConT fruit_name `AppT` ConT fruit_name))
, FunD fun_name
[ Clause
[ConP fruit_name [VarP m],ConP fruit_name [VarP n]]
(NormalB (ConE fruit_name
`AppE` UInfixE (VarE m) (VarE (mkName "+")) (VarE n)))
[]
]
]
{-# LANGUAGE TemplateHaskell #-}
module Fruit2TH where
import Fruit2THHelper
genFruit "Apples"
genFruit "Oranges"
module Fruit3 where
newtype Apples = Apples Integer
newtype Oranges = Oranges Integer
class Fruit a where
mix :: a -> a -> a
instance Fruit Apples where
Apples m `mix` Apples n = Apples (m + n)
instance Fruit Oranges where
Oranges m `mix` Oranges n = Oranges (m + n)
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Fruit3THHelper where
import Data.String
import Language.Haskell.TH
class Fruit a where
mix :: a -> a -> a
instance IsString Name where
fromString = mkName
genFruit :: String -> Q [Dec]
genFruit fruit_name' = do
let fruit_name = mkName fruit_name'
m <- newName "m"
n <- newName "n"
return
[ NewtypeD [] fruit_name []
(NormalC fruit_name [(NotStrict, ConT "Integer")])
["Show"]
, InstanceD [] (ConT "Fruit" `AppT` ConT fruit_name)
[ FunD "mix"
[ Clause
[ConP fruit_name [VarP m],ConP fruit_name [VarP n]]
(NormalB (ConE fruit_name
`AppE` UInfixE (VarE m) (VarE "+") (VarE n)))
[]
]
]
]
{-# LANGUAGE TemplateHaskell #-}
module Fruit3TH where
import Fruit3THHelper
genFruit "Apples"
genFruit "Oranges"
module FruitPhantom where
data Count a = Count Integer deriving Show
mix :: Count a -> Count a -> Count a
Count m `mix` Count n = Count (m + n)
data Apples
data Oranges
mix
is important. Otherwise it would be Count a -> Count b -> Count c
.Show
.
[]
and why are you able to show
it?{-# LANGUAGE GADTs #-}
{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}
module FruitGADTs where
data Apples
data Oranges
data Fruit a where
Apples :: Integer -> Fruit Apples
Oranges :: Integer -> Fruit Oranges
mix :: Fruit a -> Fruit a -> Fruit a
Apples m `mix` Apples n = Apples (m + n)
Oranges m `mix` Oranges n = Oranges (m + n)
(Generalized Abstract Data Types)
genFruit :: [String] -> Q [Dec]
.-ddump-splices
(dumps pieces of code generated by Template Haskell) and -v0
(silences usual (non-interesting) stuff).http://hackage.haskell.org/package/template-haskell/docs/src/Language-Haskell-TH-Syntax.html
.https://fpbrno.github.io/
.