Commit 6b45d32e authored by Steffen Michels's avatar Steffen Michels

move generic instances from iTasks to platform

parent 1e3e32d7
Pipeline #14780 passed with stage
in 1 minute and 9 seconds
...@@ -101,7 +101,7 @@ The applicable instances for the _general_ classes should be exported in the mod ...@@ -101,7 +101,7 @@ The applicable instances for the _general_ classes should be exported in the mod
This means that for example the `Functor` instance of `Maybe` should be defined in `Data.Maybe` and not in `Data.Functor`. This means that for example the `Functor` instance of `Maybe` should be defined in `Data.Maybe` and not in `Data.Functor`.
For _specific_ classes the instances for types should be exported in submodules. For _specific_ classes the instances for types should be exported in submodules.
For example, `JSONEncode` for `Map` should be exported in `Data.Map.JSONEncode` and not in `Data.Map` nor in `Text.JSON`. For example, `JSONEncode` for `Map` should be exported in `Data.Map.GenJSON` and not in `Data.Map` nor in `Text.GenJSON`.
This rule also holds for types that have multiple valid instances such as the `Monoid` for `Int`. This rule also holds for types that have multiple valid instances such as the `Monoid` for `Int`.
_general_ classes are: _general_ classes are:
......
...@@ -12,6 +12,7 @@ from Data.Monoid import class Monoid, class Semigroup ...@@ -12,6 +12,7 @@ from Data.Monoid import class Monoid, class Semigroup
from Data.Foldable import class Foldable from Data.Foldable import class Foldable
from Data.Traversable import class Traversable from Data.Traversable import class Traversable
from Data.Bifunctor import class Bifunctor from Data.Bifunctor import class Bifunctor
from Data.GenEq import generic gEq
:: Either a b = Left a | Right b :: Either a b = Left a | Right b
...@@ -33,6 +34,8 @@ instance Bifunctor Either ...@@ -33,6 +34,8 @@ instance Bifunctor Either
instance Alternative (Either m) | Monoid m instance Alternative (Either m) | Monoid m
derive gEq Either
either :: .(.a -> .c) .(.b -> .c) !(Either .a .b) -> .c either :: .(.a -> .c) .(.b -> .c) !(Either .a .b) -> .c
lefts :: .[Either .a .b] -> .[.a] lefts :: .[Either .a .b] -> .[.a]
rights :: .[Either .a .b] -> .[.b] rights :: .[Either .a .b] -> .[.b]
......
...@@ -12,6 +12,7 @@ from Data.Foldable import class Foldable(foldMap,foldl,foldr) ...@@ -12,6 +12,7 @@ from Data.Foldable import class Foldable(foldMap,foldl,foldr)
from Data.Traversable import class Traversable(traverse) from Data.Traversable import class Traversable(traverse)
import qualified Data.Traversable as T import qualified Data.Traversable as T
import Data.Bifunctor import Data.Bifunctor
import Data.GenEq
instance Functor (Either a) where instance Functor (Either a) where
fmap f (Left l) = Left l fmap f (Left l) = Left l
...@@ -80,6 +81,8 @@ where ...@@ -80,6 +81,8 @@ where
empty = Left mempty empty = Left mempty
(<|>) fa fb = either (\e->either (Left o mappend e) Right fb) Right fa (<|>) fa fb = either (\e->either (Left o mappend e) Right fb) Right fa
derive gEq Either
either :: .(.a -> .c) .(.b -> .c) !(Either .a .b) -> .c either :: .(.a -> .c) .(.b -> .c) !(Either .a .b) -> .c
either f _ (Left x) = f x either f _ (Left x) = f x
either _ g (Right y) = g y either _ g (Right y) = g y
......
definition module Data.Either.GenJSON
from Data.Maybe import :: Maybe
from Data.Either import :: Either
from Text.GenJSON import generic JSONEncode, generic JSONDecode, :: JSONNode
derive JSONEncode Either
derive JSONDecode Either
implementation module Data.Either.GenJSON
import Data.Either, Text.GenJSON
derive JSONEncode Either
derive JSONDecode Either
...@@ -23,7 +23,7 @@ gEq{|PAIR|} fx fy (PAIR x1 y1) (PAIR x2 y2) = fx x1 x2 'StdBool'. && fy y1 y2 ...@@ -23,7 +23,7 @@ gEq{|PAIR|} fx fy (PAIR x1 y1) (PAIR x2 y2) = fx x1 x2 'StdBool'. && fy y1 y2
derive gEq Int, Char, Bool, Real, String, {}, {!} derive gEq Int, Char, Bool, Real, String, {}, {!}
// standard types // standard types
derive gEq [], (,), (,,), (,,,), (,,,,), (,,,,,), (,,,,,,), (,,,,,,,) derive gEq [], (), (,), (,,), (,,,), (,,,,), (,,,,,), (,,,,,,), (,,,,,,,)
/** /**
......
...@@ -21,7 +21,7 @@ gEq{|OBJECT|} f (OBJECT x) (OBJECT y) = f x y ...@@ -21,7 +21,7 @@ gEq{|OBJECT|} f (OBJECT x) (OBJECT y) = f x y
gEq{|{}|} f xs ys = eqArray f xs ys gEq{|{}|} f xs ys = eqArray f xs ys
gEq{|{!}|} f xs ys = eqArray f xs ys gEq{|{!}|} f xs ys = eqArray f xs ys
derive gEq [], (,), (,,), (,,,), (,,,,), (,,,,,), (,,,,,,), (,,,,,,,) derive gEq [], (), (,), (,,), (,,,), (,,,,), (,,,,,), (,,,,,,), (,,,,,,,)
eqArray f xs ys = size xs == size ys && eq 0 (size xs) xs ys eqArray f xs ys = size xs == size ys && eq 0 (size xs) xs ys
where where
......
definition module Data.Set.GenJSON
from Data.Maybe import :: Maybe
from Text.GenJSON import generic JSONEncode, generic JSONDecode, :: JSONNode
from Data.Set import :: Set
derive JSONEncode Set
derive JSONDecode Set
implementation module Data.Set.GenJSON
import Data.Set, Text.GenJSON
derive JSONEncode Set
derive JSONDecode Set
...@@ -143,7 +143,7 @@ import Graphics.Scalable.Internal.Types ...@@ -143,7 +143,7 @@ import Graphics.Scalable.Internal.Types
| FlipYImg | FlipYImg
| MaskImg !ImgTagNo // the id-img pair is stored in the ImgMasks table | MaskImg !ImgTagNo // the id-img pair is stored in the ImgMasks table
derive gEq ImgTransform, Span, LookupSpan, BasicImg, FontDef, BasicImgAttr, SVGColor, Angle, ImageTag derive gEq ImgTransform, Span, LookupSpan, BasicImg, FontDef, BasicImgAttr, Angle, ImageTag
instance == ImgTransform where == a b = a === b instance == ImgTransform where == a b = a === b
equivImg :: !Img !Img -> Bool equivImg :: !Img !Img -> Bool
......
definition module System.Time.GenJSON
from Data.Maybe import :: Maybe
from System.Time import :: Timestamp
from Text.GenJSON import generic JSONEncode, generic JSONDecode, :: JSONNode
derive JSONEncode Timestamp
derive JSONDecode Timestamp
implementation module System.Time.GenJSON
import System.Time, Text.GenJSON
JSONEncode{|Timestamp|} _ (Timestamp t) = [JSONInt t]
JSONDecode{|Timestamp|} _ [JSONInt t:c] = (Just (Timestamp t), c)
JSONDecode{|Timestamp|} _ c = (Nothing, c)
...@@ -14,6 +14,7 @@ from StdOverloaded import class fromString, class toString, class ==(..) ...@@ -14,6 +14,7 @@ from StdOverloaded import class fromString, class toString, class ==(..)
from StdString import instance == {#Char} from StdString import instance == {#Char}
from Data.List import !? from Data.List import !?
from Data.Maybe import :: Maybe(..) from Data.Maybe import :: Maybe(..)
from Data.GenEq import generic gEq
:: JSONNode = JSONNull :: JSONNode = JSONNull
| JSONBool !Bool | JSONBool !Bool
...@@ -38,6 +39,8 @@ instance fromString JSONNode ...@@ -38,6 +39,8 @@ instance fromString JSONNode
*/ */
instance <<< JSONNode instance <<< JSONNode
derive gEq JSONNode
/** /**
* Encodes any value to JSON format. * Encodes any value to JSON format.
* @param The value to encode * @param The value to encode
...@@ -89,7 +92,7 @@ jsonQuery :: !String !JSONNode -> Maybe a | JSONDecode{|*|} a ...@@ -89,7 +92,7 @@ jsonQuery :: !String !JSONNode -> Maybe a | JSONDecode{|*|} a
* for each type you want to encode in JSON format. * for each type you want to encode in JSON format.
*/ */
generic JSONEncode t :: !Bool !t -> [JSONNode] generic JSONEncode t :: !Bool !t -> [JSONNode]
derive JSONEncode Int, Real, Char, Bool, String, [], (,), (,,), (,,,), (,,,,), (,,,,,), (,,,,,,), (,,,,,,,), {}, {!}, Maybe, JSONNode derive JSONEncode Int, Real, Char, Bool, String, [], (), (,), (,,), (,,,), (,,,,), (,,,,,), (,,,,,,), (,,,,,,,), {}, {!}, Maybe, JSONNode
JSONEncode{|UNIT|} _ (UNIT) = [] JSONEncode{|UNIT|} _ (UNIT) = []
JSONEncode{|PAIR|} fx fy _ (PAIR x y) = fx False x ++ fy False y JSONEncode{|PAIR|} fx fy _ (PAIR x y) = fx False x ++ fy False y
...@@ -116,7 +119,7 @@ JSONEncode{|FIELD|} fx _ (FIELD x) = fx True x ...@@ -116,7 +119,7 @@ JSONEncode{|FIELD|} fx _ (FIELD x) = fx True x
* for each type you want to parse from JSON format. * for each type you want to parse from JSON format.
*/ */
generic JSONDecode t :: !Bool ![JSONNode] -> (!Maybe t,![JSONNode]) generic JSONDecode t :: !Bool ![JSONNode] -> (!Maybe t,![JSONNode])
derive JSONDecode Int, Real, Char, Bool, String, [], (,), (,,), (,,,), (,,,,), (,,,,,), (,,,,,,), (,,,,,,,), {}, {!}, Maybe, JSONNode derive JSONDecode Int, Real, Char, Bool, String, [], (), (,), (,,), (,,,), (,,,,), (,,,,,), (,,,,,,), (,,,,,,,), {}, {!}, Maybe, JSONNode
JSONDecode{|UNIT|} _ l = (Just UNIT, l) JSONDecode{|UNIT|} _ l = (Just UNIT, l)
JSONDecode{|EITHER|} fx fy _ l = case fx False l of JSONDecode{|EITHER|} fx fy _ l = case fx False l of
......
implementation module Text.GenJSON implementation module Text.GenJSON
import StdGeneric, Data.Maybe, StdList, StdOrdList, StdString, _SystemArray, StdTuple, StdBool, StdFunc, StdOverloadedList, StdFile import StdGeneric, Data.Maybe, StdList, StdOrdList, StdString, _SystemArray, StdTuple, StdBool, StdFunc, StdOverloadedList, StdFile
import Data.List, Text, Text.PPrint, Text.GenJSON import Data.List, Text, Text.PPrint, Text.GenJSON, Data.GenEq
//Basic JSON serialization //Basic JSON serialization
instance toString JSONNode instance toString JSONNode
...@@ -482,7 +482,7 @@ where ...@@ -482,7 +482,7 @@ where
isNotNull _ = True isNotNull _ = True
JSONEncode{|FIELD|} fx _ (FIELD x) = fx True x JSONEncode{|FIELD|} fx _ (FIELD x) = fx True x
JSONEncode{|[]|} fx _ x = [JSONArray (flatten (map (fx False) x))] JSONEncode{|[]|} fx _ x = [JSONArray (flatten (map (fx False) x))]
//JSONEncode{|[]|} fx _ x = [JSONArray (flatten [fx False e \\ e <- x])] JSONEncode{|()|} _ () = [JSONNull]
JSONEncode{|(,)|} fx fy _ (x,y) = [JSONArray (fx False x ++ fy False y)] JSONEncode{|(,)|} fx fy _ (x,y) = [JSONArray (fx False x ++ fy False y)]
JSONEncode{|(,,)|} fx fy fz _ (x,y,z) = [JSONArray (fx False x ++ fy False y ++ fz False z)] JSONEncode{|(,,)|} fx fy fz _ (x,y,z) = [JSONArray (fx False x ++ fy False y ++ fz False z)]
JSONEncode{|(,,,)|} fx fy fz fi _ (x,y,z,i) = [JSONArray (fx False x ++ fy False y ++ fz False z ++ fi False i)] JSONEncode{|(,,,)|} fx fy fz fi _ (x,y,z,i) = [JSONArray (fx False x ++ fy False y ++ fz False z ++ fi False i)]
...@@ -590,6 +590,10 @@ JSONDecode{|[]|} fx _ l =:[JSONArray items:xs] ...@@ -590,6 +590,10 @@ JSONDecode{|[]|} fx _ l =:[JSONArray items:xs]
_ = (Nothing, l) _ = (Nothing, l)
JSONDecode{|[]|} fx _ l = (Nothing, l) JSONDecode{|[]|} fx _ l = (Nothing, l)
JSONDecode{|()|} _ [JSONNull:c] = (Just (), c)
JSONDecode{|()|} _ [JSONObject []:c]= (Just (), c)
JSONDecode{|()|} _ c = (Nothing, c)
JSONDecode{|(,)|} fx fy _ l =:[JSONArray [xo,yo]:xs] JSONDecode{|(,)|} fx fy _ l =:[JSONArray [xo,yo]:xs]
= case fx False [xo] of = case fx False [xo] of
(Just x,_) = case fy False [yo] of (Just x,_) = case fy False [yo] of
...@@ -769,6 +773,8 @@ instance == JSONNode where ...@@ -769,6 +773,8 @@ instance == JSONNode where
(==) JSONError JSONError = True (==) JSONError JSONError = True
(==) _ _ = False (==) _ _ = False
gEq{|JSONNode|} x y = x == y
jsonPrettyPrint :: !JSONNode -> String jsonPrettyPrint :: !JSONNode -> String
jsonPrettyPrint json = display (renderPretty 0.0 400 (pretty json)) jsonPrettyPrint json = display (renderPretty 0.0 400 (pretty json))
......
...@@ -11,8 +11,8 @@ definition module Text.HTML ...@@ -11,8 +11,8 @@ definition module Text.HTML
* http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd * http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd
*/ */
import StdString, Data.Maybe from Data.Maybe import :: Maybe
from Data.GenEq import generic gEq
/** /**
* This type provides an enumeration of all html tags. * This type provides an enumeration of all html tags.
...@@ -411,6 +411,9 @@ instance toString SVGStrokeWidth ...@@ -411,6 +411,9 @@ instance toString SVGStrokeWidth
instance toString SVGTransform instance toString SVGTransform
instance toString SVGZoomAndPan instance toString SVGZoomAndPan
derive gEq HtmlTag, HtmlAttr
derive gEq SVGElt, SVGAttr, SVGAlign, SVGColor, SVGDefer, SVGFillOpacity, SVGFuncIRI, SVGLengthAdjust, SVGLengthUnit, SVGLineCap, SVGFillRule, SVGLineJoin, SVGMeetOrSlice, SVGStrokeMiterLimit, SVGPaint, SVGStrokeDashArray, SVGStrokeDashOffset, SVGStrokeWidth, SVGTransform, SVGZoomAndPan
/* /*
* This html class makes it possible to use either strings, or html as description/message/instruction * This html class makes it possible to use either strings, or html as description/message/instruction
*/ */
......
implementation module Text.HTML implementation module Text.HTML
import StdString, StdArray, StdList, StdTuple, StdBool import StdEnv
import Data.Maybe import Data.Maybe, Data.GenEq
from StdFunc import o from StdFunc import o
from StdMisc import abort from StdMisc import abort
from Data.List import intersperse from Data.List import intersperse
...@@ -1313,3 +1313,6 @@ escapeStr str ...@@ -1313,3 +1313,6 @@ escapeStr str
| otherwise | otherwise
#! (str, _) = copyChars str 0 True (createArray escdSz '\0') 0 #! (str, _) = copyChars str 0 True (createArray escdSz '\0') 0
= str = str
derive gEq HtmlTag, HtmlAttr
derive gEq SVGElt, SVGAttr, SVGAlign, SVGColor, SVGDefer, SVGFillOpacity, SVGFuncIRI, SVGLengthAdjust, SVGLengthUnit, SVGLineCap, SVGFillRule, SVGLineJoin, SVGMeetOrSlice, SVGStrokeMiterLimit, SVGPaint, SVGStrokeDashArray, SVGStrokeDashOffset, SVGStrokeWidth, SVGTransform, SVGZoomAndPan
definition module Text.HTML.GenJSON
from Data.Maybe import :: Maybe
from Text.HTML import :: HtmlTag, :: HtmlAttr
from Text.HTML import :: SVGElt, :: SVGAttr, :: SVGAlign, :: SVGColor, :: SVGDefer, :: SVGFillOpacity, :: SVGFuncIRI, :: SVGLengthAdjust
from Text.HTML import :: SVGLengthUnit, :: SVGLineCap, :: SVGFillRule, :: SVGLineJoin, :: SVGMeetOrSlice, :: SVGStrokeMiterLimit, :: SVGPaint
from Text.HTML import :: SVGStrokeDashArray, :: SVGStrokeDashOffset, :: SVGStrokeWidth, :: SVGTransform, :: SVGZoomAndPan
from Text.GenJSON import generic JSONEncode, generic JSONDecode, :: JSONNode
derive JSONEncode HtmlTag, HtmlAttr
derive JSONEncode SVGElt, SVGAttr, SVGAlign, SVGColor, SVGDefer, SVGFillOpacity, SVGFuncIRI, SVGLengthAdjust, SVGLengthUnit, SVGLineCap, SVGFillRule, SVGLineJoin, SVGMeetOrSlice, SVGStrokeMiterLimit, SVGPaint, SVGStrokeDashArray, SVGStrokeDashOffset, SVGStrokeWidth, SVGTransform, SVGZoomAndPan
derive JSONDecode HtmlTag, HtmlAttr
derive JSONDecode SVGElt, SVGAttr, SVGAlign, SVGColor, SVGDefer, SVGFillOpacity, SVGFuncIRI, SVGLengthAdjust, SVGLengthUnit, SVGLineCap, SVGFillRule, SVGLineJoin, SVGMeetOrSlice, SVGStrokeMiterLimit, SVGPaint, SVGStrokeDashArray, SVGStrokeDashOffset, SVGStrokeWidth, SVGTransform, SVGZoomAndPan
implementation module Text.HTML.GenJSON
import Text.HTML, Text.GenJSON
derive JSONEncode HtmlTag, HtmlAttr
derive JSONEncode SVGElt, SVGAttr, SVGAlign, SVGColor, SVGDefer, SVGFillOpacity, SVGFuncIRI, SVGLengthAdjust, SVGLengthUnit, SVGLineCap, SVGFillRule, SVGLineJoin, SVGMeetOrSlice, SVGStrokeMiterLimit, SVGPaint, SVGStrokeDashArray, SVGStrokeDashOffset, SVGStrokeWidth, SVGTransform, SVGZoomAndPan
derive JSONDecode HtmlTag, HtmlAttr
derive JSONDecode SVGElt, SVGAttr, SVGAlign, SVGColor, SVGDefer, SVGFillOpacity, SVGFuncIRI, SVGLengthAdjust, SVGLengthUnit, SVGLineCap, SVGFillRule, SVGLineJoin, SVGMeetOrSlice, SVGStrokeMiterLimit, SVGPaint, SVGStrokeDashArray, SVGStrokeDashOffset, SVGStrokeWidth, SVGTransform, SVGZoomAndPan
...@@ -8,11 +8,12 @@ from Text import class Text(split,join,concat), instance Text String ...@@ -8,11 +8,12 @@ from Text import class Text(split,join,concat), instance Text String
from Data.Map import :: Map from Data.Map import :: Map
import qualified Data.Map as DM import qualified Data.Map as DM
import StdList, StdBool, StdOverloaded import StdList, StdBool, StdOverloaded, StdString
import StdDebug import StdDebug
import Data.List import Data.List
import Data.Tuple import Data.Tuple
import Data.Maybe
import Control.Applicative import Control.Applicative
import Text.HTML import Text.HTML
......
...@@ -6,6 +6,7 @@ definition module System.Time ...@@ -6,6 +6,7 @@ definition module System.Time
from StdString import class toString from StdString import class toString
import StdOverloaded import StdOverloaded
from Data.GenEq import generic gEq
/** /**
* The resolution of the system clock ticks * The resolution of the system clock ticks
...@@ -31,6 +32,9 @@ CLK_PER_SEC :== 1000000 ...@@ -31,6 +32,9 @@ CLK_PER_SEC :== 1000000
* The time data type represents a number of seconds since the epoch (1-1-1970). * The time data type represents a number of seconds since the epoch (1-1-1970).
*/ */
:: Timestamp = Timestamp !Int :: Timestamp = Timestamp !Int
derive gEq Timestamp
/** /**
* The clock data type represents a number of CPU clock ticks. * The clock data type represents a number of CPU clock ticks.
*/ */
......
implementation module System.Time implementation module System.Time
import StdString, StdArray, StdClass, StdOverloaded, StdInt, StdMisc, StdBool import StdString, StdArray, StdClass, StdOverloaded, StdInt, StdMisc, StdBool
import Data.GenEq
import System.OS import System.OS
import System._Pointer, System._Posix import System._Pointer, System._Posix
import Text import Text
...@@ -8,6 +9,8 @@ import Text ...@@ -8,6 +9,8 @@ import Text
//String buffer size //String buffer size
MAXBUF :== 256 MAXBUF :== 256
derive gEq Timestamp
instance == Timestamp instance == Timestamp
where where
(==) (Timestamp t1) (Timestamp t2) = t1 == t2 (==) (Timestamp t1) (Timestamp t2) = t1 == t2
......
...@@ -6,6 +6,7 @@ definition module System.Time ...@@ -6,6 +6,7 @@ definition module System.Time
from StdString import class toString from StdString import class toString
import StdOverloaded import StdOverloaded
from Data.GenEq import generic gEq
/** /**
* The resolution of the system clock ticks * The resolution of the system clock ticks
*/ */
...@@ -30,6 +31,9 @@ CLK_PER_SEC :== 1000 ...@@ -30,6 +31,9 @@ CLK_PER_SEC :== 1000
* The time data type represents a number of seconds since the epoch (1-1-1970). * The time data type represents a number of seconds since the epoch (1-1-1970).
*/ */
:: Timestamp = Timestamp !Int :: Timestamp = Timestamp !Int
derive gEq Timestamp
/** /**
* The clock data type represents a number of CPU clock ticks. * The clock data type represents a number of CPU clock ticks.
*/ */
......
...@@ -5,6 +5,7 @@ import System._Pointer ...@@ -5,6 +5,7 @@ import System._Pointer
import System._WinBase import System._WinBase
import Data.Integer import Data.Integer
import Data.List import Data.List
import Data.GenEq
from Data.Func import $ from Data.Func import $
import Text import Text
...@@ -13,6 +14,8 @@ import code from library "msvcrt.txt" ...@@ -13,6 +14,8 @@ import code from library "msvcrt.txt"
//String buffer size //String buffer size
MAXBUF :== 256 MAXBUF :== 256
derive gEq Timestamp
instance == Timestamp instance == Timestamp
where where
(==) (Timestamp t1) (Timestamp t2) = t1 == t2 (==) (Timestamp t1) (Timestamp t2) = t1 == t2
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment