Commit 523a01d6 authored by Steffen Michels's avatar Steffen Michels

resolve merge conflict

parents 63adf6b2 642bf63d
Pipeline #15357 passed with stage
in 1 minute and 43 seconds
......@@ -3,7 +3,8 @@ Cloogle indexes documentation of the syntax elements it stores, through
functions in `Clean.Doc`. Docblocks are comments that start with `/**` and have
a leading asterisk on every line (leading whitespace is ignored). The first
part of the docblock is taken as a general description. Below the description,
documentation fields can be added with `@`.
documentation fields can be added with `@`. Currently, documentation fields
should have only one line.
An example is below:
......@@ -38,9 +39,12 @@ fields. For example:
## Markup in documentation
Some simple markup is allowed in documentation:
Some simple Markdown-inspired markup is allowed in documentation:
- `` `foo` `` renders `foo` in monospaced font.
- Code blocks can be surrounded by `` ``` `` on separate lines. The start of a
code block can indicate the language (for highlighting purposes), as in
`` ```clean ``.
- `{{bar}}` marks `bar` as a defined entity (that can be searched for).
- Double newlines distinguish paragraphs; single newlines are ignored unless
followed by a hyphen.
......@@ -51,6 +55,11 @@ The tables below describe which fields and documentation types can be used for
different syntax elements, and what they should document. An extension, to
document test properties, is discussed below.
What fields are accepted for what syntax elements is defined by the records in
`Clean.Doc`; how they are parsed in the instances of the generic function
`docBlockToDoc`. The below is merely a convenient representation of the same
information.
| | Description | `@param` | `@result` | `@type` | `@var` | `@representation` | `@throws` | `@complexity`
|--------------|-------------|----------|-----------|---------|--------|-------------------|-----------|--------------
| Class | ![][y] | ![][y]<sup>1</sup> | ![][y]<sup>1</sup> | | ![][y] | |
......@@ -87,23 +96,6 @@ With [clean-test-properties][]' `testproperties` tool, [Gast][] test programs
can be generated with properties from docblocks. For this, several additional
fields can be used, which are further documented by [clean-test-properties][].
Briefly, `@property` on functions describes the actual property. When this uses
type variables, `@property-test-with` can be used to show how to instantiate
them. On the module, `@property-bootstrap` can be used to add bootstrap code,
like imports, to the top of the program. For example:
```clean
/**
* @property plus_commutative: A. x :: a; y :: a:
* x + y == y + x
* @property-test-with a = Int
* @property-test-with a = Real
*/
```
This will test the property `\x y -> x + y == y + x` where `x` and `y` are of
type `Int` or `Real`.
[clean-test-properties]: https://gitlab.science.ru.nl/clean-and-itasks/clean-test-properties
[Gast]: https://gitlab.science.ru.nl/clean-and-itasks/gast
......
......@@ -70,11 +70,11 @@ id x = x
```
Several JavaDoc like parameters are supported such as `@param`, `@result`,
`@type`, `@var` and `@representation`. More info about this can be found
[here](https://github.com/clean-cloogle/Cloogle#clean-documentation).
We use `@complexity` for the complexity order. Some other special fields are
used, like `@gin-icon`, but one should be reluctant with inventing new field
names. If there is a general use case, adding it can be discussed.
`@type`, `@var` and `@representation`. More info about this can be found in
[DOCUMENTATION.md](DOCUMENTATION.md). We use `@complexity` for the complexity
order. Some other special fields are used, like `@gin-icon`, but one should be
reluctant with inventing new field names. If there is a general use case,
adding it can be discussed.
## Layout
......
......@@ -253,7 +253,7 @@ parseDoc :: !String -> Either ParseError (!d, ![ParseWarning]) | docBlockToDoc{|
*/
generic docBlockToDoc d :: !(Either [String] DocBlock) -> Either ParseError (!d, ![ParseWarning])
derive docBlockToDoc UNIT, PAIR, EITHER, CONS, OBJECT, FIELD of d, RECORD
derive docBlockToDoc UNIT, PAIR, EITHER, CONS, OBJECT, FIELD of {gfd_name}, RECORD
derive docBlockToDoc String, [], Maybe, Type
derive docBlockToDoc ModuleDoc, FunctionDoc, ClassMemberDoc, ClassDoc,
ConstructorDoc, TypeDoc
......
......@@ -114,14 +114,18 @@ parseDoc s = docBlockToDoc{|*|} (Left [s])
generic docBlockToDoc d :: !(Either [String] DocBlock) -> Either ParseError (!d, ![ParseWarning])
docBlockToDoc{|String|} (Left []) = Left InternalNoDataError
docBlockToDoc{|String|} (Left ss) = Right (trim $ last ss, [])
docBlockToDoc{|String|} _ = abort "error in docBlockToDoc{|String|}\n"
docBlockToDoc{|[]|} fx (Left ss) = (\vws -> (map fst vws, flatten (map snd vws)) ) <$> mapM fx (map (Left o pure) ss)
docBlockToDoc{|Maybe|} fx (Left []) = Right (Nothing, [])
docBlockToDoc{|[]|} _ _ = abort "error in docBlockToDoc{|[]|}\n"
docBlockToDoc{|Maybe|} fx (Left []) = Right (Nothing, [])
docBlockToDoc{|Maybe|} fx ss=:(Left _) = appFst Just <$> fx ss
docBlockToDoc{|Maybe|} _ _ = abort "error in docBlockToDoc{|Maybe|}\n"
docBlockToDoc{|UNIT|} _ = Right (UNIT, [])
docBlockToDoc{|PAIR|} fx fy db=:(Right _) = liftA2 (\(x,ws) (y,ws`) -> (PAIR x y, ws ++ ws`)) (fx db) (fy db)
docBlockToDoc{|FIELD of d|} fx (Right db) = case fx (Left [v \\ (k,v) <- db | k matches d.gfd_name]) of
docBlockToDoc{|PAIR|} _ _ _ = abort "error in docBlockToDoc{|PAIR|}\n"
docBlockToDoc{|FIELD of {gfd_name}|} fx (Right db) = case fx (Left [v \\ (k,v) <- db | k matches gfd_name]) of
Right (f, ws) -> Right (FIELD f, ws)
Left InternalNoDataError -> Left (MissingField d.gfd_name)
Left InternalNoDataError -> Left (MissingField gfd_name)
Left e -> Left e
where
(matches) infix 4 :: !String !String -> Bool
......@@ -132,6 +136,7 @@ where
k` == "return" && name == "results"
where
k` = {if (c == '-') '_' c \\ c <-: k}
docBlockToDoc{|FIELD of {gfd_name}|} _ _ = abort "error in docBlockToDoc{|FIELD|}\n"
docBlockToDoc{|RECORD|} fx (Left [s]) = case parseDocBlock s of
Right (db, ws) -> case fx (Right db) of
Right (v, ws`) -> Right (RECORD v, ws ++ ws`)
......@@ -147,6 +152,7 @@ docBlockToDoc{|EITHER|} fl fr doc = case fl doc of
docBlockToDoc{|OBJECT|} fx doc = appFst OBJECT <$> fx doc
docBlockToDoc{|MultiLineString|} (Left [s]) = Right (MultiLine $ trimMultiLine $ split "\n" s, [])
docBlockToDoc{|MultiLineString|} _ = abort "error in docBlockToDoc{|MultiLineString|}\n"
docBlockToDoc{|ParamDoc|} (Left [s]) = case findName (fromString s) of
Just (name,rest) -> Right (
......@@ -162,11 +168,13 @@ where
| not (isEmpty name) && not (isEmpty cs) && hd cs == ':'
= Just (toString name, dropWhile isSpace (tl cs))
= Nothing
docBlockToDoc{|ParamDoc|} _ = abort "error in docBlockToDoc{|ParamDoc|}\n"
docBlockToDoc{|Type|} (Left []) = Left InternalNoDataError
docBlockToDoc{|Type|} (Left ss) = case [v \\ Just v <- map ('T'.parseType o fromString) ss] of
[] -> Left (UnknownError "no parsable type")
vs -> Right (last vs, [])
docBlockToDoc{|Type|} _ = abort "error in docBlockToDoc{|Type|}\n"
docBlockToDoc{|Property|} (Left [s]) = let [signature:property] = split "\n" s in
parseSignature signature >>= \(sig,ws1) ->
......@@ -199,18 +207,21 @@ where
parseProperty :: ![String] -> Either ParseError (!String, ![ParseWarning])
parseProperty ss = Right (trimMultiLine ss, [])
docBlockToDoc{|Property|} _ = abort "error in docBlockToDoc{|Property|}\n"
docBlockToDoc{|PropertyVarInstantiation|} (Left [s]) = case split "=" s of
[var:type:[]] -> case 'T'.parseType (fromString type) of
Just t -> Right (PropertyVarInstantiation (trim var, t), [])
Nothing -> Left (UnknownError "type could not be parsed")
_ -> Left (UnknownError "property var instantiation could not be parsed")
docBlockToDoc{|PropertyVarInstantiation|} _ = abort "error in docBlockToDoc{|PropertyVarInstantiation|}\n"
docBlockToDoc{|PropertyTestGenerator|} (Left [s]) = case 'T'.parseType (fromString sig) of
Just t -> Right (PropertyTestGenerator t (trimMultiLine imp), [])
Nothing -> Left (UnknownError "type could not be parsed")
where
[sig:imp] = split "\n" s
docBlockToDoc{|PropertyTestGenerator|} _ = abort "error in docBlockToDoc{|PropertyTestGenerator|}\n"
derive docBlockToDoc ModuleDoc, FunctionDoc, ClassMemberDoc, ConstructorDoc,
ClassDoc, TypeDoc
......@@ -225,31 +236,40 @@ printDoc d = join "\n * "
] +++
"\n */"
where
(Right fields`) = docToDocBlock{|*|} False d
fields` = case docToDocBlock{|*|} False d of
Right fs -> fs
_ -> abort "error in printDoc\n"
fields = filter ((<>) "description" o fst) fields`
desc = lookup "description" fields`
generic docToDocBlock a :: Bool a -> Either [String] DocBlock
docToDocBlock{|String|} True s = Left [s]
docToDocBlock{|String|} _ _ = abort "error in docToDocBlock{|String|}\n"
docToDocBlock{|[]|} fx True xs = Left [x \\ Left xs` <- map (fx True) xs, x <- xs`]
docToDocBlock{|[]|} _ _ _ = abort "error in docToDocBlock{|[]|}\n"
docToDocBlock{|Maybe|} fx True mb = case mb of
Nothing -> Left []
Just x -> fx True x
docToDocBlock{|PAIR|} fx fy False (PAIR x y) = Right (xs ++ ys)
where
(Right xs) = fx False x
(Right ys) = fy False y
docToDocBlock{|FIELD of d|} fx False (FIELD x) = Right [(name,x) \\ x <- xs]
docToDocBlock{|Maybe|} _ _ _ = abort "error in docToDocBlock{|Maybe|}\n"
docToDocBlock{|PAIR|} fx fy False (PAIR x y) = case fx False x of
Right xs -> case fy False y of
Right ys -> Right (xs ++ ys)
_ -> abort "error in docToDocBlock{|PAIR|}\n"
_ -> abort "error in docToDocBlock{|PAIR|}\n"
docToDocBlock{|PAIR|} _ _ _ _ = abort "error in docToDocBlock{|PAIR|}\n"
docToDocBlock{|FIELD of d|} fx False (FIELD x) = case fx True x of
Left xs -> Right [(name,x) \\ x <- xs]
_ -> abort "error in docToDocBlock{|FIELD|}\n"
where
(Left xs) = fx True x
name = {if (c=='_') '-' c \\ c <-: name`}
name`
| endsWith "ies" d.gfd_name = d.gfd_name % (0,size d.gfd_name-4) +++ "y"
| endsWith "s" d.gfd_name = d.gfd_name % (0,size d.gfd_name-2)
| otherwise = d.gfd_name
docToDocBlock{|FIELD|} _ _ _ = abort "error in docToDocBlock{|FIELD|}\n"
docToDocBlock{|RECORD|} fx False (RECORD x) = fx False x
docToDocBlock{|RECORD|} _ _ _ = abort "error in docToDocBlock{|RECORD|}\n"
docToDocBlock{|ParamDoc|} True pd = case pd.ParamDoc.name of
Nothing -> case pd.ParamDoc.description of
......@@ -258,12 +278,18 @@ docToDocBlock{|ParamDoc|} True pd = case pd.ParamDoc.name of
Just n -> case pd.ParamDoc.description of
Nothing -> Left [n]
Just d -> Left [n +++ ": " +++ d]
docToDocBlock{|ParamDoc|} _ _ = abort "error in docToDocBlock{|ParamDoc|}\n"
docToDocBlock{|MultiLineString|} True (MultiLine s) = Left [s]
docToDocBlock{|MultiLineString|} _ _ = abort "error in docToDocBlock{|MultiLineString|}\n"
docToDocBlock{|Type|} True t = Left [toString t]
docToDocBlock{|Type|} _ _ = abort "error in docToDocBlock{|Type|}\n"
docToDocBlock{|Property|} True (ForAll name args impl) = Left
[name +++ ": A." +++ join "; " [a +++ " :: " <+ t \\ (a,t) <- args] +++ ":\n" +++ impl]
docToDocBlock{|Property|} _ _ = abort "error in docToDocBlock{|Property|}\n"
docToDocBlock{|PropertyVarInstantiation|} True (PropertyVarInstantiation (a,t)) = Left [a +++ " = " <+ t]
docToDocBlock{|PropertyVarInstantiation|} _ _ = abort "error in docToDocBlock{|PropertyVarInstantiation|}\n"
docToDocBlock{|PropertyTestGenerator|} True (PropertyTestGenerator t impl) = Left [t <+ "\n" +++ impl]
docToDocBlock{|PropertyTestGenerator|} _ _ = abort "error in docToDocBlock{|PropertyTestGenerator|}\n"
derive docToDocBlock ModuleDoc, FunctionDoc, ClassMemberDoc, ClassDoc,
ConstructorDoc, TypeDoc
......@@ -302,6 +328,8 @@ where
parseFs :: ![Char] ![Char] !DocBlock -> Either ParseError (!DocBlock, ![ParseWarning])
parseFs field val d = Right ([(toString field,toString (rtrim val)):d], [])
parseFields _
= abort "error in parseDocBlock\n"
prepareString :: (String -> Either ParseError [[Char]])
prepareString = checkAsterisks o map trim o break '\n' o fromString
......@@ -340,6 +368,7 @@ where
toString (MissingAsterisk l) = "Doc error: missing leading asterisk in '" +++ l +++ "'"
toString (MissingField f) = "Doc error: required field '" +++ f +++ "' was missing"
toString (UnknownError e) = "Doc error: " +++ e
toString InternalNoDataError = "Doc error: internal parsing error"
traceParseWarnings :: ![ParseWarning] !a -> a
traceParseWarnings [] x = x
......
......@@ -3,6 +3,7 @@ implementation module Clean.Types
from StdOverloaded import class ==(..), class length(..)
from StdClass import class Eq
import StdList
import StdMisc
import StdTuple
from StdString import instance == {#Char}
import StdBool
......@@ -45,6 +46,7 @@ where
name :: !Type -> TypeVar
name (Cons v _) = v
name (Var v) = v
name _ = abort "error in allVars\n"
allUniversalVars :: !Type -> [TypeVar]
allUniversalVars (Forall vs t tc) = removeDup (flatten (map allVars vs) ++ allUniversalVars t)
......@@ -58,47 +60,60 @@ allUniversalVars (Arrow Nothing) = []
allUniversalVars (Strict t) = allUniversalVars t
isVar :: !Type -> Bool
isVar (Var _) = True; isVar _ = False
isVar t = t=:(Var _)
fromVar :: !Type -> TypeVar
fromVar (Var v) = v
fromVar t = case t of
Var v -> v
_ -> abort "error in fromVar\n"
fromVarLenient :: !Type -> TypeVar
fromVarLenient (Var v) = v
fromVarLenient (Cons v _) = v
fromVarLenient (Uniq t) = fromVarLenient t
fromVarLenient t = case t of
Var v -> v
Cons v _ -> v
Uniq t -> fromVarLenient t
Strict t -> fromVarLenient t
_ -> abort "missing case in fromVarLenient\n"
isCons :: !Type -> Bool
isCons (Cons _ _) = True; isCons _ = False
isCons t = t=:(Cons _ _)
isCons` :: TypeVar !Type -> Bool
isCons` v (Cons v` _) = v == v`; isCons` _ _ = False
isCons` v t = case t of
Cons v` _ -> v == v`
_ -> False
isVarOrCons` :: TypeVar !Type -> Bool
isVarOrCons` v (Var v`) = v == v`
isVarOrCons` v (Cons v` _) = v == v`
isVarOrCons` _ _ = False
isVarOrCons` v t = case t of
Var v` -> v == v`
Cons v` _ -> v == v`
_ -> False
isType :: !Type -> Bool
isType (Type _ _) = True; isType _ = False
isType t = t=:(Type _ _)
isFunc :: !Type -> Bool
isFunc (Func _ _ _) = True; isFunc _ = False
isFunc t = t=:(Func _ _ _)
isUniq :: !Type -> Bool
isUniq (Uniq _) = True; isUniq _ = False
isUniq t = t=:(Uniq _)
isForall :: !Type -> Bool
isForall (Forall _ _ _) = True; isForall _ = False
isForall t = t=:(Forall _ _ _)
fromForall :: !Type -> Type
fromForall (Forall _ t _) = t
fromForall t = case t of
Forall _ t _ -> t
_ -> abort "fromForall called on non-Forall\n"
isArrow :: !Type -> Bool
isArrow (Arrow _) = True; isArrow _ = False
isArrow t = t=:(Arrow _)
fromArrow :: !Type -> Maybe Type
fromArrow (Arrow t) = t
fromArrow t = case t of
Arrow t -> t
_ -> abort "fromArrow called on non-Arrow\n"
fromUnifyingAssignment :: !UnifyingAssignment -> TVAssignment
fromUnifyingAssignment (LeftToRight x) = x
......@@ -110,7 +125,9 @@ arity (Func is _ _) = length is
arity (Var _) = 0
arity (Cons _ ts) = length ts
arity (Strict t) = arity t
//TODO arity of Uniq / Forall / Arrow?
arity (Uniq _) = abort "what is the arity of Uniq?\n" // TODO
arity (Forall _ _ _) = abort "what is the arity of Forall?\n" // TODO
arity (Arrow _) = abort "what is the arity of Arrow?\n" // TODO
removeTypeContexts :: !Type -> Type
removeTypeContexts (Type s ts) = Type s $ map removeTypeContexts ts
......
......@@ -2,6 +2,7 @@ implementation module Clean.Types.Parse
from StdFunc import o
import StdList
import StdMisc
import StdString
import StdTuple
......@@ -46,8 +47,12 @@ from Text.Parsers.Simple.Core import :: Parser, :: Error,
instance == Token
where
== (TIdent a) (TIdent b) = a == b
== (TVar a) (TVar b) = a == b
== (TIdent a) b = case b of
TIdent b -> a == b
_ -> False
== (TVar a) b = case b of
TVar b -> a == b
_ -> False
== TArrow b = b=:TArrow
== TComma b = b=:TComma
== TStar b = b=:TStar
......@@ -140,10 +145,10 @@ where
<|> liftM Var var
ident :: Parser Token String
ident = (\(TIdent id)->id) <$> pSatisfy isTIdent
ident = (\tk -> case tk of TIdent id -> id; _ -> abort "error in type parser\n") <$> pSatisfy isTIdent
var :: Parser Token TypeVar
var = (\(TVar var)->var) <$> pSatisfy isTVar
var = (\tk -> case tk of TVar id -> id; _ -> abort "error in type parser\n") <$> pSatisfy isTVar
cons = var
unqvar = var
......
......@@ -3,6 +3,7 @@ implementation module Clean.Types.Util
import StdArray
import StdBool
from StdFunc import flip, id, o
import StdMisc
import StdOrdList
import StdString
import StdTuple
......@@ -95,15 +96,9 @@ where
instance print TypeDefRhs
where
print _ (TDRCons ext cs) = "\n\t= " -- makeADT ext cs
where
makeADT :: !Bool ![Constructor] -> String
makeADT exten [] = if exten " .." ""
makeADT False [c1:cs]
= concat (c1 -- "\n" --
concat [concat ("\t| " -- c -- "\n") \\ c <- cs])
makeADT True cs = concat (makeADT False cs -- "\t| ..")
print _ (TDRNewType c) = " =: " -- c
print _ (TDRCons ext cs) = "\n\t= " -- printADT ext cs
print _ (TDRMoreConses cs) = "\n\t| " -- printADT False cs
print _ (TDRNewType c) = " =: " -- c
print _ (TDRRecord _ exi fields) = " =" --
if (isEmpty exi) [] (" E." -- printersperse False " " exi -- ":") --
"\n\t" -- makeRecord exi fields
......@@ -124,6 +119,15 @@ where
print _ (TDRAbstract (Just rhs)) = " /*" -- rhs -- " */"
print _ (TDRAbstractSynonym t) = " (:== " -- t -- ")"
printADT :: !Bool ![Constructor] -> String
printADT True cs = case cs of
[] -> ".."
cs -> concat (printADT False cs -- "\t| ..")
printADT False cs = case cs of
[] -> ""
[c1:cs] -> concat (c1 -- "\n" --
concat [concat ("\t| " -- c -- "\n") \\ c <- cs])
typeConstructorName :: !Bool !Bool !String ![Type] -> [String]
typeConstructorName isInfix isArg t as
# isInfix = isInfix && not (isEmpty as)
......@@ -191,24 +195,28 @@ resolve_synonyms :: ('M'.Map String [TypeDef]) !Type -> ([TypeDef], Type)
resolve_synonyms tds (Type t ts)
# (syns, ts) = appFst (removeDupTypedefs o flatten) $ unzip $ map (resolve_synonyms tds) ts
= case candidates of
[] = (syns, Type t ts)
[] -> (syns, Type t ts)
[syn=:{td_args, td_rhs=TDRSynonym synt}:_]
# newargs = map ((+++) "__" o fromVar) td_args
# (Just t)
= assignAll [(fromVar a, Var n) \\ a <- td_args & n <- newargs] synt
>>= assignAll [(a,r) \\ a <- newargs & r <- ts]
| length td_args <> length ts
# (Type r rs) = t
# t = Type r $ rs ++ drop (length td_args) ts
= appFst ((++) [syn:syns]) $ resolve_synonyms tds t
= appFst ((++) [syn:syns]) $ resolve_synonyms tds t
# t = case assignAll [(fromVar a, Var n) \\ a <- td_args & n <- newargs] synt
>>= assignAll [(a,r) \\ a <- newargs & r <- ts] of
Just t -> t
_ -> abort "error in resolve_synonyms_Type\n"
| length td_args <> length ts -> case t of
Type r rs
# t = Type r $ rs ++ drop (length td_args) ts
-> appFst ((++) [syn:syns]) $ resolve_synonyms tds t
_ -> abort "error in resolve_synonyms_Type\n"
-> appFst ((++) [syn:syns]) $ resolve_synonyms tds t
_ -> abort "error in resolve_synonyms_Type\n"
where
candidates = [td \\ td=:{td_rhs=TDRSynonym syn} <- fromMaybe [] $ 'M'.get t tds
| length td.td_args <= tslen && (isType syn || length td.td_args == tslen)]
where tslen = length ts
resolve_synonyms tds (Func is r tc)
# (syns, [r:is]) = appFst (removeDupTypedefs o flatten) $ unzip $ map (resolve_synonyms tds) [r:is]
= (syns, Func is r tc)
= case appFst (removeDupTypedefs o flatten) $ unzip $ map (resolve_synonyms tds) [r:is] of
(syns, [r:is]) -> (syns, Func is r tc)
_ -> abort "error in resolve_synonyms_Func\n"
resolve_synonyms _ (Var v)
= ([], Var v)
resolve_synonyms tds (Cons v ts)
......
......@@ -103,16 +103,18 @@ where
isOctDigit c = '0' <= c && c <= '7'
parseType :: TarParser TarFileType
parseType = StateT $ \[c:cs] -> case c of
'0' = Ok (NormalFile, cs)
'1' = Ok (HardLink, cs)
'2' = Ok (SymLink, cs)
'3' = Ok (CharSpecial, cs)
'4' = Ok (BlockSpecial, cs)
'5' = Ok (Directory, cs)
'6' = Ok (FIFO, cs)
'7' = Ok (Contiguous, cs)
c = Error $ UnsupportedFileTypeId c
parseType = StateT $ \cs -> case cs of
[] -> Error UnexpectedEOS
[c:cs] -> case c of
'0' = Ok (NormalFile, cs)
'1' = Ok (HardLink, cs)
'2' = Ok (SymLink, cs)
'3' = Ok (CharSpecial, cs)
'4' = Ok (BlockSpecial, cs)
'5' = Ok (Directory, cs)
'6' = Ok (FIFO, cs)
'7' = Ok (Contiguous, cs)
c = Error $ UnsupportedFileTypeId c
skip :: Int -> TarParser ()
skip i = StateT $ \cs -> Ok ((), drop i cs)
......
......@@ -17,6 +17,12 @@ where
pure :: a -> f a
(<*>) infixl 4 :: !(f (a -> b)) (f a) -> f b
(<*) infixl 4 :: !(f a) (f b) -> f a
(<*) fa fb = pure (\x _->x) <*> fa <*> fb
(*>) infixl 4 :: !(f a) (f b) -> f b
(*>) fa fb = pure (\_ x->x) <*> fa <*> fb
class Alternative f | Applicative f
where
empty :: f a
......@@ -37,29 +43,6 @@ some :: (f a) -> f [a] | Alternative f
many :: (f a) -> f [a] | Alternative f
/**
* Sequence actions and take the value of the right argument.
* Previously, this was a normal function with the type context Applicative f
* and an implementation similar to the instance for f now. However, for some
* types there are more efficient possibilities. Making this a class with a
* default implementation allows overriding the instance in such cases, like
* for Maybe here.
* Be aware that the execution order has to be correct: the left hand side must
* be evaluated before the right hand side.
*/
class (*>) infixl 4 f :: !(f a) (f b) -> f b | Applicative f
instance *> f
/**
* Sequence actions and take the value of the left argument.
* For the reason behind making this a class rather than a normal function, see
* the documentation on *>.
* Be aware that the execution order has to be correct: the left hand side must
* be evaluated before the right hand side.
*/
class (<*) infixl 4 f :: !(f a) (f b) -> f a | Applicative f
instance <* f
(<**>) infixl 4 :: (f a) (f (a -> b)) -> f b | Applicative f
lift :: a -> f a | Applicative f
......
......@@ -6,6 +6,17 @@ from Data.Monoid import class Monoid, class Semigroup
import qualified Data.Monoid as DM
from StdFunc import id, o, flip, const
class Applicative f | Functor f
where
pure :: a -> f a
(<*>) infixl 4 :: !(f (a -> b)) (f a) -> f b
(<*) infixl 4 :: !(f a) (f b) -> f a