TypeFamilies
#-}
module Data.HList.Graph
- ( HNodeSet
- , HNodeIDSet
- , HNode(..)
- , HGraph(..)
+ ( Graph(..)
+ , NodeSet
+ , NodeIDSet
+ , Node(..)
+ , LPath(..)
- , HNodeIDA
+ , IsEmpty
+
+ , NodeIDA
)
where
import Data.HList.Prelude
--- HNodeSet
-class HNodeSet ns
-instance HNodeSet HNil
-instance HNodeSet ns => HNodeSet (HCons n ns)
+-- NodeSet
+class NodeSet ns
+instance NodeSet Nil
+instance NodeSet ns => NodeSet (Cons n ns)
+
+-- NodeIDSet
+class NoDuplicates ids => NodeIDSet ids
+instance NodeIDSet Nil
+instance (OccursNot id ids, NodeIDSet ids) => NodeIDSet (Cons id ids)
--- HNodeIDSet
-class HNoDuplicates nids => HNodeIDSet nids
-instance HNodeIDSet HNil
-instance (HOccursNot nid nids, HNodeIDSet nids) => HNodeIDSet (HCons nid nids)
+-- LPath (list of labeled node IDs)
+class LPath p
+instance LPath Nil
+instance LPath p => LPath (Cons (Cons l id) p)
--- HNode
-class HNodeIDSet (HLinksFrom n) => HNode n
+-- Node
+class NodeIDSet (LinksFrom n) => Node n
where
- type HNodeID n
- type HLinksFrom n
+ type NodeID n
+ type LinksFrom n
--- HNodeIDA
-data HNodeIDA
-instance ApplyT HNodeIDA n where
- type Apply HNodeIDA n = HNodeID n
+-- NodeIDA
+data NodeIDA
+instance ApplyT NodeIDA n where
+ type Apply NodeIDA n = NodeID n
--- HGraph
-class ( HNodeSet (HNodes g)
- , HNoDuplicates (HMap HNodeIDA g)
+-- Graph
+class ( NodeSet (Nodes g)
+ , NoDuplicates (Map NodeIDA g)
)
- => HGraph g
+ => Graph g
where
- type HNodes g
+ type Empty g
+ type Nodes g
---type family HGetNode g n
\ No newline at end of file
+-- IsEmpty
+type family IsEmpty g
--- /dev/null
+{-# LANGUAGE
+ EmptyDataDecls,
+ TypeFamilies,
+ TypeOperators,
+ UndecidableInstances
+ #-}
+module Data.HList.Heap
+ ( Heap
+
+ , Empty
+ , Unit
+ , Insert
+ , Merge
+ , MergeAll
+ , IsEmpty
+ , FindMin
+ , DeleteMin
+ , SplitMin
+ )
+ where
+
+import Data.HList
+import Types.Data.Bool
+import Types.Data.Ord
+
+
+data Empty
+data Node key value heaps
+
+class Heap h
+instance Heap Empty
+instance Heap hs => Heap (Node k v hs)
+
+type Unit k v = Node k v Nil
+
+type family IsEmpty h
+type instance IsEmpty Empty = True
+type instance IsEmpty (Node k v hs) = False
+
+type Insert k v h = Merge (Unit k v) h
+
+type family Merge h1 h2
+type instance Merge h1 Empty = h1
+type instance Merge Empty h2 = h2
+type instance Merge (Node k1 v1 hs1) (Node k2 v2 hs2)
+ = If (k1 :<: k2)
+ (Node k1 v1 (Cons (Node k2 v2 hs2) hs1))
+ (Node k2 v2 (Cons (Node k1 v1 hs1) hs2))
+
+type family MergeAll hs
+type instance MergeAll Nil = Empty
+type instance MergeAll (Cons h Nil) = h
+type instance MergeAll (Cons h (Cons h' hs))
+ = Merge (Merge h h') (MergeAll hs)
+
+type family FindMin h
+type instance FindMin (Node k v hs) = Cons k v
+
+type family DeleteMin h
+type instance DeleteMin Empty = Empty
+type instance DeleteMin (Node k v hs) = MergeAll hs
+
+type family SplitMin h
+type instance SplitMin (Node k v hs) = Cons k (Cons v (MergeAll hs))
UndecidableInstances
#-}
module Data.HList.Prelude
- ( HList
+ ( List
- , HNil(..)
+ , Nil(..)
, hNil
- , HCons(..)
+ , Cons(..)
, hCons
- , HExtendT(..)
- , HAppendT(..)
+ , ExtendT(..)
+ , AppendT(..)
, ApplyT(..)
, Apply2T(..)
, Id(..)
- , HAppendA(..)
+ , AppendA(..)
- , HFoldrT(..)
- , HConcatT(..)
- , HMapT(..)
+ , FoldrT(..)
+ , ConcatT(..)
+ , MapT(..)
- , HAll
- , HLength
+ , All
+ , Length
, Fail
, TypeFound
, TypeNotFound
- , HOccursMany(..)
- , HOccursMany1(..)
- , HOccursOpt(..)
- , HOccurs(..)
- , HOccursNot
+ , OccursMany(..)
+ , OccursMany1(..)
+ , OccursOpt(..)
+ , Occurs(..)
+ , OccursNot
- , HNoDuplicates
+ , NoDuplicates
)
where
import Types.Data.Num hiding ((:*:))
--- HList
-class HList l
+-- List
+class List l
--- HNil
-data HNil
- = HNil
+-- Nil
+data Nil
+ = Nil
deriving (Show, Eq, Ord, Read, Typeable)
-instance HList HNil
+instance List Nil
-hNil :: HNil
-hNil = HNil
+hNil :: Nil
+hNil = Nil
--- HCons
-data HCons e l
- = HCons e l
+-- Cons
+data Cons e l
+ = Cons e l
deriving (Show, Eq, Ord, Read, Typeable)
-instance HList l => HList (HCons e l)
+instance List l => List (Cons e l)
-hCons :: HList l => e -> l -> HCons e l
-hCons = HCons
+hCons :: List l => e -> l -> Cons e l
+hCons = Cons
--- HExtendT
+-- ExtendT
infixr 2 :&:
infixr 2 .&.
-class HExtendT e l where
+class ExtendT e l where
type e :&: l
(.&.) :: e -> l -> e :&: l
-instance HExtendT e HNil where
- type e :&: HNil = HCons e HNil
+instance ExtendT e Nil where
+ type e :&: Nil = Cons e Nil
e .&. nil = hCons e nil
-instance HList l => HExtendT e (HCons e' l) where
- type e :&: HCons e' l = HCons e (HCons e' l)
- e .&. HCons e' l = hCons e (hCons e' l)
+instance List l => ExtendT e (Cons e' l) where
+ type e :&: Cons e' l = Cons e (Cons e' l)
+ e .&. Cons e' l = hCons e (hCons e' l)
--- HAppendT
+-- AppendT
infixr 1 :++:
infixr 1 .++.
-class HAppendT l l' where
+class AppendT l l' where
type l :++: l'
(.++.) :: l -> l' -> l :++: l'
-instance HList l => HAppendT HNil l where
- type HNil :++: l = l
+instance List l => AppendT Nil l where
+ type Nil :++: l = l
_ .++. l = l
-instance ( HList (l :++: l')
- , HAppendT l l'
- ) => HAppendT (HCons e l) l' where
- type HCons e l :++: l' = HCons e (l :++: l')
- (HCons e l) .++. l' = hCons e (l .++. l')
+instance ( List (l :++: l')
+ , AppendT l l'
+ ) => AppendT (Cons e l) l' where
+ type Cons e l :++: l' = Cons e (l :++: l')
+ (Cons e l) .++. l' = hCons e (l .++. l')
-- ApplyT
class ApplyT f a where
type Apply Id a = a
apply _ a = a
--- HAppendA
-data HAppendA = HAppendA
+-- AppendA
+data AppendA = AppendA
-instance HAppendT a b => Apply2T HAppendA a b where
- type Apply2 HAppendA a b = a :++: b
+instance AppendT a b => Apply2T AppendA a b where
+ type Apply2 AppendA a b = a :++: b
apply2 _ a b = a .++. b
--- HFoldrT
-class HFoldrT f v l where
- type HFoldr f v l
- hFoldr :: f -> v -> l -> HFoldr f v l
+-- FoldrT
+class FoldrT f v l where
+ type Foldr f v l
+ hFoldr :: f -> v -> l -> Foldr f v l
-instance HFoldrT f v HNil where
- type HFoldr f v HNil = v
+instance FoldrT f v Nil where
+ type Foldr f v Nil = v
hFoldr _ v _ = v
-instance ( HFoldrT f v l
- , Apply2T f e (HFoldr f v l)
- ) => HFoldrT f v (HCons e l) where
- type HFoldr f v (HCons e l) = Apply2 f e (HFoldr f v l)
- hFoldr f v (HCons e l) = apply2 f e (hFoldr f v l)
+instance ( FoldrT f v l
+ , Apply2T f e (Foldr f v l)
+ ) => FoldrT f v (Cons e l) where
+ type Foldr f v (Cons e l) = Apply2 f e (Foldr f v l)
+ hFoldr f v (Cons e l) = apply2 f e (hFoldr f v l)
--- HConcatT
-class HConcatT ls where
- type HConcat ls
- hConcat :: ls -> HConcat ls
+-- ConcatT
+class ConcatT ls where
+ type Concat ls
+ hConcat :: ls -> Concat ls
-instance HFoldrT HAppendA HNil ls => HConcatT ls where
- type HConcat ls = HFoldr HAppendA HNil ls
- hConcat ls = hFoldr HAppendA hNil ls
+instance FoldrT AppendA Nil ls => ConcatT ls where
+ type Concat ls = Foldr AppendA Nil ls
+ hConcat ls = hFoldr AppendA hNil ls
--- HMapT
-class HMapT f l where
- type HMap f l
- hMap :: f -> l -> HMap f l
+-- MapT
+class MapT f l where
+ type Map f l
+ hMap :: f -> l -> Map f l
-instance HMapT f HNil where
- type HMap f HNil = HNil
+instance MapT f Nil where
+ type Map f Nil = Nil
hMap _ _ = hNil
instance ( ApplyT f x
- , HMapT f xs
- , HList (HMap f xs)
- ) => HMapT f (HCons x xs) where
- type HMap f (HCons x xs) = HCons (Apply f x) (HMap f xs)
- hMap f (HCons x xs) = hCons (apply f x) (hMap f xs)
-
--- HAll
-type family HAll f l
-type instance HAll f HNil = True
-type instance HAll f (HCons x xs) = If (Apply f x) (HAll f xs) False
-
--- HLength
-type family HLength l
-type instance HLength HNil = D0
-type instance HLength (HCons e l) = Succ (HLength l)
+ , MapT f xs
+ , List (Map f xs)
+ ) => MapT f (Cons x xs) where
+ type Map f (Cons x xs) = Cons (Apply f x) (Map f xs)
+ hMap f (Cons x xs) = hCons (apply f x) (hMap f xs)
+
+-- All
+type family All f l
+type instance All f Nil = True
+type instance All f (Cons x xs) = If (Apply f x) (All f xs) False
+
+-- Length
+type family Length l
+type instance Length Nil = D0
+type instance Length (Cons e l) = Succ (Length l)
-- Fail
class Fail a
--- HOccursMany (zero or more)
-class HOccursMany e l where
+-- OccursMany (zero or more)
+class OccursMany e l where
hOccursMany :: l -> [e]
-instance HOccursMany e HNil where
+instance OccursMany e Nil where
hOccursMany _ = []
-instance ( HList l
- , HOccursMany e l
+instance ( List l
+ , OccursMany e l
)
- => HOccursMany e (HCons e l)
+ => OccursMany e (Cons e l)
where
- hOccursMany (HCons e l) = e : hOccursMany l
+ hOccursMany (Cons e l) = e : hOccursMany l
-instance ( HList l
- , HOccursMany e l
+instance ( List l
+ , OccursMany e l
)
- => HOccursMany e (HCons e' l)
+ => OccursMany e (Cons e' l)
where
- hOccursMany (HCons _ l) = hOccursMany l
+ hOccursMany (Cons _ l) = hOccursMany l
--- HOccursMany1 (one or more)
-class HOccursMany1 e l where
+-- OccursMany1 (one or more)
+class OccursMany1 e l where
hOccursMany1 :: l -> [e]
-instance Fail (TypeNotFound e) => HOccursMany1 e HNil where
+instance Fail (TypeNotFound e) => OccursMany1 e Nil where
hOccursMany1 _ = undefined
-instance ( HList l
- , HOccursMany e l
+instance ( List l
+ , OccursMany e l
)
- => HOccursMany1 e (HCons e l)
+ => OccursMany1 e (Cons e l)
where
- hOccursMany1 (HCons e l) = e : hOccursMany l
+ hOccursMany1 (Cons e l) = e : hOccursMany l
-instance ( HList l
- , HOccursMany1 e l
+instance ( List l
+ , OccursMany1 e l
)
- => HOccursMany1 e (HCons e' l)
+ => OccursMany1 e (Cons e' l)
where
- hOccursMany1 (HCons _ l) = hOccursMany1 l
+ hOccursMany1 (Cons _ l) = hOccursMany1 l
--- HOccursOpt (zero or one)
-class HOccursOpt e l where
+-- OccursOpt (zero or one)
+class OccursOpt e l where
hOccursOpt :: l -> Maybe e
-instance HOccursOpt e HNil where
+instance OccursOpt e Nil where
hOccursOpt _ = Nothing
-instance HOccursNot e l => HOccursOpt e (HCons e l) where
- hOccursOpt (HCons e _) = Just e
+instance OccursNot e l => OccursOpt e (Cons e l) where
+ hOccursOpt (Cons e _) = Just e
-instance HOccursOpt e l => HOccursOpt e (HCons e' l) where
- hOccursOpt (HCons _ l) = hOccursOpt l
+instance OccursOpt e l => OccursOpt e (Cons e' l) where
+ hOccursOpt (Cons _ l) = hOccursOpt l
--- HOccurs (one)
-class HOccurs e l where
+-- Occurs (one)
+class Occurs e l where
hOccurs :: l -> e
data TypeNotFound e
-instance Fail (TypeNotFound e) => HOccurs e HNil
+instance Fail (TypeNotFound e) => Occurs e Nil
where
hOccurs = undefined
-instance ( HList l
- , HOccursNot e l
+instance ( List l
+ , OccursNot e l
)
- => HOccurs e (HCons e l)
+ => Occurs e (Cons e l)
where
- hOccurs (HCons e _) = e
+ hOccurs (Cons e _) = e
-instance ( HList l
- , HOccurs e l
+instance ( List l
+ , Occurs e l
)
- => HOccurs e (HCons e' l)
+ => Occurs e (Cons e' l)
where
- hOccurs (HCons _ l) = hOccurs l
+ hOccurs (Cons _ l) = hOccurs l
--- HOccursNot (zero)
+-- OccursNot (zero)
data TypeFound e
-class HOccursNot e l
-instance HOccursNot e HNil
-instance Fail (TypeFound e) => HOccursNot e (HCons e l)
-instance HOccursNot e l => HOccursNot e (HCons e' l)
-
--- HNoDuplicates
-class HNoDuplicates l
-instance HNoDuplicates HNil
-instance HOccursNot e l => HNoDuplicates (HCons e l)
+class OccursNot e l
+instance OccursNot e Nil
+instance Fail (TypeFound e) => OccursNot e (Cons e l)
+instance OccursNot e l => OccursNot e (Cons e' l)
+
+-- NoDuplicates
+class NoDuplicates l
+instance NoDuplicates Nil
+instance OccursNot e l => NoDuplicates (Cons e l)
{-
{-
class (Show s, Eq s) => HString s
-instance HString HNil
+instance HString Nil
instance ( Show c
, Show s
, Eq s
, IntegerT c
)
- => HString (HCons c s)
+ => HString (Cons c s)
hString :: QuasiQuoter
hString = QuasiQuoter quoteStrExp quoteStrPat
]
quoteStrPat :: String -> PatQ
-quoteStrPat [] = varP (mkName "HNil")
-quoteStrPat (c:cs) = conP (mkName "HCons")
+quoteStrPat [] = varP (mkName "Nil")
+quoteStrPat (c:cs) = conP (mkName "Cons")
[ sigP wildP (decLiteralT $ toInteger $ fromEnum c)
, quoteStrPat cs
]
-- Data.HList
, (.&.)
- , HNil(..)
+ , Nil(..)
-- Database.RRDtool.Expression
, Constant(..)
where
type DSName (ExternalDataSource vn) = vn
-type instance MentionedVars (ExternalDataSource vn) = HNil
+type instance MentionedVars (ExternalDataSource vn) = Nil
-- |ComputedDataSource is for storing the result of a formula applied
-- to other data sources in the RRD. This data source is not supplied
cdsName = "foo"
-- , cdsExpr = Previous :<: Const 100
-- , cdsExpr = Var "foo" :<: Const 100
- , cdsExpr = AverageOf (Const 100 .*. Const 200 .*. HNil)
+ , cdsExpr = AverageOf (Const 100 .*. Const 200 .*. Nil)
}
-}
newtype RRDInterval = RRDInterval NominalDiffTime
class RRDSpec s
-instance ( HOccurs RRDPath s
- , HOccursOpt KeepOldRRD s
- , HOccursOpt RRDStartTime s
- , HOccursOpt RRDInterval s
- , HOccurs RRDDataSources s
+instance ( Occurs RRDPath s
+ , OccursOpt KeepOldRRD s
+ , OccursOpt RRDStartTime s
+ , OccursOpt RRDInterval s
+ , Occurs RRDDataSources s
)
=> RRDSpec s
instance ( DSList l
, DataSource d
)
- => NonEmptyDSList (HCons d l)
+ => NonEmptyDSList (Cons d l)
class DSList l
-instance DSList HNil
+instance DSList Nil
instance ( DSList l
, DataSource d
)
- => DSList (HCons d l)
+ => DSList (Cons d l)
data RRDDataSources
= forall l.
( NonEmptyDSList l
- , HGraph l -- FIXME: this constraint is too weak
+ , Graph l -- FIXME: this constraint is too weak
)
=> RRDDataSources l
-- RRDDataSources is a graph.
instance ( DSList g
- , HNodeSet g
- , HNoDuplicates (HMap HNodeIDA g)
+ , NodeSet g
+ , NoDuplicates (Map NodeIDA g)
)
- => HGraph g
+ => Graph g
where
- type HNodes g = g
+ type Empty g = Nil
+ type Nodes g = g
-instance ( HNodeIDSet (MentionedVars d)
+type instance IsEmpty Nil = True
+type instance IsEmpty (Cons e l) = False
+
+instance ( NodeIDSet (MentionedVars d)
, DataSource d
)
- => HNode d
+ => Node d
where
- type HNodeID d = DSName d
- type HLinksFrom d = MentionedVars d
+ type NodeID d = DSName d
+ type LinksFrom d = MentionedVars d
-- |The 'createRRD' function lets you set up new Round Robin Database
-- (RRD) files. The file is created at its final, full size and filled
testMain = let s = RRDPath "test.rrd" .&.
KeepOldRRD .&.
RRDDataSources testDSList .&.
- HNil
+ Nil
in
createRRD s
cdsName = [$hString|baz|]
, cdsExpr = Var [$hString|foo|] -- should typecheck!
}
- in a .&. b .&. HNil
\ No newline at end of file
+ in a .&. b .&. Nil
\ No newline at end of file
type family IsIterativeExpr e
type family IsExprSet es
-type instance IsExprSet HNil = True
-type instance IsExprSet (HCons e es) = IsExpr e :&&: IsExprSet es
+type instance IsExprSet Nil = True
+type instance IsExprSet (Cons e es) = IsExpr e :&&: IsExprSet es
type family IsCommonExprSet es
-type instance IsCommonExprSet HNil = True
-type instance IsCommonExprSet (HCons e es) = IsCommonExpr e :&&: IsCommonExprSet es
+type instance IsCommonExprSet Nil = True
+type instance IsCommonExprSet (Cons e es) = IsCommonExpr e :&&: IsCommonExprSet es
type family IsIterativeExprSet es
-type instance IsIterativeExprSet HNil = True
-type instance IsIterativeExprSet (HCons e es) = IsIterativeExpr e :&&: IsIterativeExprSet es
+type instance IsIterativeExprSet Nil = True
+type instance IsIterativeExprSet (Cons e es) = IsIterativeExpr e :&&: IsIterativeExprSet es
-- Constants and variable names
data Constant
type instance IsExpr Constant = True
type instance IsCommonExpr Constant = True
type instance IsIterativeExpr Constant = True
-type instance MentionedVars Constant = HNil
+type instance MentionedVars Constant = Nil
{- This is what we want to do but GHC can't handle this for now.
-class ( (HLengthOf str :<=: D19) ~ True
+class ( (Length str :<=: D19) ~ True
, HString str
)
=> IsVarName str
-}
type family IsVarName str
-type instance IsVarName str = ( (HLength str :>: D0)
+type instance IsVarName str = ( (Length str :>: D0)
:&&:
- (HLength str :<=: D19)
+ (Length str :<=: D19)
:&&:
- (HAll IsGoodLetterForVarNameA str)
+ (All IsGoodLetterForVarNameA str)
)
type family IsGoodLetterForVarName c
type instance IsExpr (Variable vn) = True
type instance IsCommonExpr (Variable vn) = True
type instance IsIterativeExpr (Variable vn) = True
-type instance MentionedVars (Variable vn) = vn :&: HNil
+type instance MentionedVars (Variable vn) = vn :&: Nil
type family IsVariableSet vs
-type instance IsVariableSet HNil = True
-type instance IsVariableSet (HCons v vs) = IsVarName v :&&: IsVariableSet vs
+type instance IsVariableSet Nil = True
+type instance IsVariableSet (Cons v vs) = IsVarName v :&&: IsVariableSet vs
-- Common operators
data CommonUnaryOp a
type instance IsExpr (CommonSetOp es) = IsExprSet es
type instance IsCommonExpr (CommonSetOp es) = IsCommonExprSet es
type instance IsIterativeExpr (CommonSetOp es) = IsIterativeExprSet es
-type instance MentionedVars (CommonSetOp es) = HConcat (HMap MentionedVarsA es)
+type instance MentionedVars (CommonSetOp es) = Concat (Map MentionedVarsA es)
-- TrendOp
data TrendOp vn e
type instance IsExpr CommonValue = True
type instance IsCommonExpr CommonValue = True
type instance IsIterativeExpr CommonValue = True
-type instance MentionedVars CommonValue = HNil
+type instance MentionedVars CommonValue = Nil
-- Iterative special values
data IterativeValue
type instance IsExpr IterativeValue = True
type instance IsCommonExpr IterativeValue = False
type instance IsIterativeExpr IterativeValue = True
-type instance MentionedVars IterativeValue = HNil
+type instance MentionedVars IterativeValue = Nil
-- Iterative special values of something
data IterativeValueOf vn
type instance IsExpr (IterativeValueOf vn) = IsVarName vn
type instance IsCommonExpr (IterativeValueOf vn) = False
type instance IsIterativeExpr (IterativeValueOf vn) = IsVarName vn
-type instance MentionedVars (IterativeValueOf vn) = vn :&: HNil
+type instance MentionedVars (IterativeValueOf vn) = vn :&: Nil
-- Aggregative operators (fairly restricted due to rrdtool's
-- restriction)
| LSLCorrel !(Variable vn)
deriving (Show, Eq, Ord)
-type instance MentionedVars (AggregativeUnaryOp vn) = vn :&: HNil
+type instance MentionedVars (AggregativeUnaryOp vn) = vn :&: Nil
Database.RRDtool.Create
Database.RRDtool.Expression
Data.HList
+ Data.HList.Heap
Data.HList.Graph
Data.HList.Prelude
Data.HList.String
projects / hs-rrdtool.git / commitdiff