File: Has.hs

package info (click to toggle)
haskell-derive 2.5.16-1
  • links: PTS, VCS
  • area: main
  • in suites: jessie, jessie-kfreebsd
  • size: 460 kB
  • sloc: haskell: 3,686; makefile: 5
file content (40 lines) | stat: -rw-r--r-- 1,169 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
{-|
    Has is a pseudo derivation.  For each field of any constructor of
    the data type, Has generates @has@/FieldName/ which returns 'True'
    if given the the given field is a member of the constructor of the
    passed object, and 'False' otherwise.
-}
module Data.Derive.Has(makeHas) where

{-
test :: Computer

hasSpeed :: Computer -> Bool
hasSpeed _ = True

hasWeight :: Computer -> Bool
hasWeight Laptop{} = True
hasWeight _ = False

test :: Sample
-}

import Language.Haskell
import Data.Derive.Internal.Derivation
import Data.List


makeHas :: Derivation
makeHas = derivationCustom "Has" $ \(_,d) -> Right $ concatMap (makeHasField d) $ dataDeclFields d


makeHasField :: DataDecl -> String -> [Decl]
makeHasField d field = [TypeSig sl [name has] typ, binds has ms]
    where
        has = "has" ++ title field
        typ = TyFun (dataDeclType d) (tyCon "Bool")
        (yes,no) = partition (elem field . map fst . ctorDeclFields) $ dataDeclCtors d
        match pat val = ([pat], con val)

        ms | null no = [match PWildCard "True"]
           | otherwise = [match (PRec (qname $ ctorDeclName c) []) "True" | c <- yes] ++ [match PWildCard "False"]