Guest User

Untitled

a guest
Sep 19th, 2018
70
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 4.17 KB | None | 0 0
  1. data EconSection
  2. = EconGeneral
  3. | EconProduction
  4.  
  5. data EconPhase
  6. = Oil
  7. | Water
  8. | NumPhase Nat
  9.  
  10. data ContState
  11. = ContNone
  12. | ContProd EconPhase
  13.  
  14. data Keyword : EconSection -> ContState -> ContState -> Type where
  15. Prod : (p : EconPhase) -> Keyword EconProduction c (ContProd p)
  16. Continue : Keyword s c c
  17.  
  18. data Expression : (s : EconSection) ->
  19. (d : ContState) ->
  20. Keyword s c d ->
  21. Type where
  22. ExProc : Double -> Double -> Expression EconProduction (ContProd p) k
  23.  
  24. data Line : EconSection -> ContState -> ContState -> Type where
  25. L : (k : Keyword s c d) -> Expression s d k -> Line s c d
  26.  
  27. data Lines : EconSection -> ContState -> Type where
  28. First : Line s ContNone d -> Lines s d
  29. Then : Lines s c -> Line s c d -> Lines s d
  30.  
  31. infixl 0 `Then`
  32.  
  33. good : Lines EconProduction (ContProd (NumPhase 1))
  34. good = First (L (Prod Oil) (ExProc 23.2 70.1))
  35. `Then` (L (Continue) (ExProc 27.9 1.2))
  36. `Then` (L (Prod (NumPhase 1)) (ExProc 91.2 7014.1))
  37. `Then` (L (Continue) (ExProc 91.2 7014.1))
  38.  
  39. {-# LANGUAGE GADTs, KindSignatures, DataKinds #-}
  40. {-# LANGUAGE RankNTypes, TypeInType, TypeOperators #-}
  41. {-# LANGUAGE TypeFamilies, TypeFamilyDependencies, MultiParamTypeClasses #-}
  42.  
  43. import Data.Kind (Type)
  44.  
  45. data Nat
  46. = Z
  47. | S Nat
  48.  
  49. data SNat :: Nat -> Type where
  50. SZ :: SNat 'Z
  51. SS :: SNat n -> SNat ('S n)
  52.  
  53. data SSNat :: forall (n :: Nat) . SNat n -> Type where
  54. SSZ :: SSNat 'SZ
  55. SSS :: SSNat n -> SSNat ('SS n)
  56.  
  57. type family SingNat (n :: Nat) :: SNat n where
  58. SingNat 'Z = 'SZ
  59. SingNat ('S n) = 'SS (SingNat n)
  60.  
  61. data EconSection
  62. = EconGeneral
  63. | EconProduction
  64.  
  65. data SEconSection :: EconSection -> Type where
  66. SEconGeneral :: SEconSection 'EconGeneral
  67. SEconProduction :: SEconSection 'EconProduction
  68.  
  69. type family SingSection (s :: EconSection) :: SEconSection s where
  70. SingSection 'EconGeneral = 'SEconGeneral
  71. SingSection 'EconProduction = 'SEconProduction
  72.  
  73. data EconPhase
  74. = Oil
  75. | Water
  76. | NumPhase Nat
  77.  
  78. data SEconPhase :: EconPhase -> Type where
  79. SOil :: SEconPhase 'Oil
  80. SWater :: SEconPhase 'Water
  81. SNumPhase :: SNat n -> SEconPhase ('NumPhase n)
  82.  
  83. data SSEconPhase :: forall (p :: EconPhase) . SEconPhase p -> Type where
  84. SSOil :: SSEconPhase 'SOil
  85. SSWater :: SSEconPhase 'SWater
  86. SSNumPhase :: SSNat n -> SSEconPhase ('SNumPhase n)
  87.  
  88. type family SingEconPhase (p :: EconPhase) :: SEconPhase p where
  89. SingEconPhase 'Oil = 'SOil
  90. SingEconPhase 'Water = 'SWater
  91. SingEconPhase ('NumPhase n) = 'SNumPhase (SingNat n)
  92.  
  93. data ContState
  94. = ContNone
  95. | ContProd EconPhase
  96.  
  97. data SContState :: ContState -> Type where
  98. SContNone :: SContState 'ContNone
  99. SContProd :: SEconPhase p -> SContState ('ContProd p)
  100.  
  101. type family SingContState (c :: ContState) :: SContState c where
  102. SingContState 'ContNone = 'SContNone
  103. SingContState (ContProd p) = 'SContProd (SingEconPhase p)
  104.  
  105. data Keyword :: EconSection -> ContState -> ContState -> Type where
  106. Prod :: SEconPhase p -> Keyword 'EconProduction c ('ContProd p)
  107. Continue :: Keyword s c c
  108.  
  109. data SKeyword :: forall (s :: EconSection) (c :: ContState) (d :: ContState) .
  110. Keyword s c d -> Type where
  111. SProd :: SSEconPhase p -> SKeyword ('Prod p)
  112. SContinue :: SKeyword 'Continue
  113.  
  114. data Expression :: forall (s :: EconSection) (c :: ContState) (d :: ContState) .
  115. SEconSection s -> SContState d -> Keyword s c d -> Type where
  116. ExProc :: Double -> Double -> Expression SEconProduction (SContProd p) k
  117.  
  118. type family KWSection k where
  119. KWSection (Keyword s _ _) = s
  120.  
  121. type family KWFrom k where
  122. KWFrom (Keyword _ c _) = c
  123.  
  124. type family KWTo k where
  125. KWTo (Keyword _ _ d) = d
  126.  
  127. data Line :: EconSection -> ContState -> ContState -> Type where
  128. L :: SKeyword (k :: Keyword s c d)
  129. -> Expression (SingSection s) (SingContState d) k
  130. -> Line s c d
  131.  
  132. data Lines :: EconSection -> ContState -> Type where
  133. First :: Line s 'ContNone d -> Lines s d
  134. Then :: Lines s c -> Line s c d -> Lines s d
  135.  
  136. infixl 0 `Then`
  137.  
  138. good :: Lines 'EconProduction ('ContProd ('NumPhase ('S 'Z)))
  139. good = First (L (SProd SSOil) (ExProc 23.2 70.1))
  140. `Then` (L (SContinue) (ExProc 27.9 1.2))
  141. `Then` (L (SProd (SSNumPhase (SSS SSZ))) (ExProc 91.2 7014.1))
  142. `Then` (L (SContinue) (ExProc 91.2 7014.1))
Add Comment
Please, Sign In to add comment