Verified Commit 0030a984 authored by Camil Staps's avatar Camil Staps 🙂

Merge branch 'master' into docs

parents a7c7af44 bf9a0a74
test:
before_script:
- install_clean.sh bundle-complete && apt-get update -qq && apt-get install -y -qq build-essential
image: "camilstaps/clean:nightly"
script:
- make -C tests/linux64
......@@ -63,7 +63,7 @@ evalRWST m r s
execRWST :: (RWST r w s m a) r s -> m (s, w) | Monad m
execRWST m r s
= runRWST m r s
>>= \(_, s`, w) -> pure (s, w)
>>= \(_, s`, w) -> pure (s`, w)
mapRWST :: ((m (a, s, w)) -> n (b, s, w`)) (RWST r w s m a) -> RWST r w` s n b
mapRWST f m = RWST (\r s -> f (runRWST m r s))
......
......@@ -7,7 +7,7 @@ import StdArray, StdOverloaded, StdOrdList, StdTuple, StdString, StdBool, StdMis
import Data.Maybe, Data.List
import GenPrint, GenEq
derive gEq EdgeStyle, NodeStyle, DirType, NodeShape, Side, ArrowShape, ArrowType, Arrow, Color
derive gEq EdgeStyle, NodeStyle, DirType, NodeShape, Side, ArrowShape, ArrowType, Arrow, Color, Maybe
derive gPrint EdgeStyle, NodeStyle, DirType, NodeShape, Side, ArrowShape,
Maybe, CompassPoint, StartStyle, ClusterMode, OutputMode,
PageDir, RankDir, RankType
......
......@@ -4,6 +4,11 @@ from Data.Functor import class Functor
from Data.Maybe import :: Maybe
import StdList, GenEq
/**
* An element in the list, or Nothing if it does not exist.
*/
(!?) infixl 9 :: ![.a] !Int -> Maybe .a
/**
* The first element of the list.
*/
......
......@@ -3,6 +3,11 @@ implementation module Data.List
import Data.Maybe, StdTuple, StdBool, StdEnum, StdFunc, StdList, StdOrdList, Data.Functor, GenEq
from StdMisc import abort
(!?) infixl 9 :: ![.a] !Int -> Maybe .a
(!?) [x:_] 0 = Just x
(!?) [_:xs] i = xs !? (i-1)
(!?) _ _ = Nothing
// Haskell Data.List compat
head :: ![.a] -> .a
......
......@@ -3,6 +3,9 @@ definition module System.FilePath
Module for manipulation of file and directory paths
*/
from Data.Error import :: MaybeError
from System.OSError import :: OSError, :: OSErrorCode, :: OSErrorMessage, :: MaybeOSError
:: FilePath :== String
/**
......@@ -81,3 +84,8 @@ replaceFileName :: !FilePath !String -> FilePath
*/
dropFileName :: !FilePath -> FilePath
/**
* Get the full path name, without '.', '..' or symbolic links.
*/
getFullPathName :: !FilePath !*World -> (!MaybeOSError FilePath, !*World)
......@@ -5,8 +5,11 @@ import StdList
import StdTuple
import StdString
import Data.Error
import Text
import System.OS
import System.OSError
import qualified System._FilePath as _FilePath
pathSeparator :: Char
pathSeparator = OS_PATH_SEPARATOR
......@@ -72,5 +75,6 @@ replaceFileName path fn = takeDirectory path </> fn
dropFileName :: !FilePath -> FilePath
dropFileName path = takeDirectory path
getFullPathName :: !FilePath !*World -> (!MaybeOSError FilePath, !*World)
getFullPathName p w = '_FilePath'.getFullPathName p w
......@@ -10,6 +10,7 @@ definition module Text.JSON
import StdGeneric, Data.Maybe, StdList, StdString
from StdFile import class <<<
from Data.List import !?
:: JSONNode = JSONNull
| JSONBool !Bool
......@@ -146,10 +147,11 @@ JSONDecode{|FIELD of {gfd_name}|} fx _ l =:[JSONObject fields]
| otherwise = findField match xs
findField match [] = []
JSONDecode{|FIELD of {gfd_index}|} fx _ l =:[JSONArray fields]
#! field = fields !! gfd_index
= case fx True [field] of
(Just x, _) = (Just (FIELD x), l)
(_, _) = (Nothing, l)
= case fields !? gfd_index of
Nothing = (Nothing, l)
Just field = case fx True [field] of
(Just x, _) = (Just (FIELD x), l)
(_, _) = (Nothing, l)
JSONDecode{|FIELD|} fx _ l = (Nothing, l)
/**
......
implementation module Text.JSON
import StdGeneric, Data.Maybe, StdList, StdOrdList, StdString, _SystemArray, StdTuple, StdBool, StdFunc, StdOverloadedList, StdFile
import Text, Text.PPrint
import Data.List, Text, Text.PPrint
//Basic JSON serialization
instance toString JSONNode
......@@ -573,10 +573,11 @@ JSONDecode{|FIELD of {gfd_name}|} fx _ l =:[JSONObject fields]
| otherwise = findField match xs
findField match [] = []
JSONDecode{|FIELD of {gfd_index}|} fx _ l =:[JSONArray fields]
#! field = fields !! gfd_index
= case fx True [field] of
(Just x, _) = (Just (FIELD x), l)
(_, _) = (Nothing, l)
= case fields !? gfd_index of
Nothing = (Nothing, l)
Just field = case fx True [field] of
(Just x, _) = (Just (FIELD x), l)
(_, _) = (Nothing, l)
JSONDecode{|FIELD|} fx _ l = (Nothing, l)
JSONDecode{|[]|} fx _ l =:[JSONArray items:xs]
......
definition module Text.Parsers.Simple.Core
from Control.Applicative import class Applicative (..), class Alternative (..), *>, <*
from Control.Applicative import class Applicative (..), class Alternative (..)
from Control.Monad import class Monad (..), class MonadPlus (..)
from Data.Either import :: Either (..)
from Data.Functor import class Functor (..), <$>
......
......@@ -56,6 +56,7 @@ read :: !Int !Pointer !Int !*w -> (!Int, !*w)
write :: !Int !{#Char} !Int !*w -> (!Int, !*w)
select_ :: !Int !Pointer !Pointer !Pointer !Pointer !*w -> (!Int, !*w)
kill :: !Int !Int !*w -> (!Int, !*w)
timegm :: !{#Int} -> Int
//Memory (impure)
malloc :: !Int -> Pointer
......
......@@ -122,6 +122,11 @@ kill pid sig world = code {
ccall kill "II:I:A"
}
timegm :: !{#Int} -> Int
timegm tm = code {
ccall timegm "A:I"
}
malloc :: !Int -> Pointer
malloc num = code {
ccall malloc "p:p"
......
......@@ -55,6 +55,7 @@ read :: !Int !Pointer !Int !*w -> (!Int, !*w)
write :: !Int !{#Char} !Int !*w -> (!Int, !*w)
select_ :: !Int !Pointer !Pointer !Pointer !Pointer !*w -> (!Int, !*w)
kill :: !Int !Int !*w -> (!Int, !*w)
timegm :: !{#Int} -> Int
//Memory (impure)
malloc :: !Int -> Pointer
......
......@@ -121,6 +121,10 @@ kill pid sig world = code {
ccall kill "II:I:A"
}
timegm :: !{#Int} -> Int
timegm tm = code {
ccall timegm "A:I"
}
malloc :: !Int -> Pointer
malloc num = code {
......
......@@ -60,9 +60,15 @@ gmTime :: !*World -> (!Tm, !*World)
*/
localTime :: !*World -> (!Tm, !*World)
/**
* Convert a Tm record (local time) to a Timestamp value
* Convert a Tm record (local time) to a Timestamp value.
* This is not a pure function as it depends on the current local time zone.
*/
mkTime :: !Tm -> Timestamp
mkTime :: !Tm !*World-> (!Timestamp, !*World)
/**
* Convert a Tm record (UTC) to a Timestamp value.
* No time zone conversion is done.
*/
timeGm :: !Tm -> Timestamp
/**
* Calculate the difference in seconds between two times
*/
......
implementation module System.Time
import StdString, StdArray, StdClass, StdOverloaded, StdInt
import System._Pointer
import System._Pointer, System._Posix
import Text
//String buffer size
......@@ -80,16 +80,19 @@ localTime world
ccall localtime "A:p:p"
}
mkTime :: !Tm -> Timestamp
mkTime tm
# t = mkTimeC (packTm tm)
= Timestamp t
where
mkTimeC :: !{#Int} -> Int
mkTimeC tm = code {
ccall mktime "A:I"
mkTime :: !Tm !*World-> (!Timestamp, !*World)
mkTime tm world
# (t, world) = mkTimeC (packTm tm) world
= (Timestamp t, world)
where
mkTimeC :: !{#Int} !*World -> (!Int, !*World)
mkTimeC tm world = code {
ccall mktime "A:I:A"
}
timeGm :: !Tm -> Timestamp
timeGm tm = Timestamp (timegm (packTm tm))
diffTime :: !Timestamp !Timestamp -> Int
diffTime (Timestamp t1) (Timestamp t2) = t1 - t2
......
definition module System._FilePath
from Data.Error import :: MaybeError
from System.OSError import :: MaybeOSError, :: OSError, :: OSErrorMessage, :: OSErrorCode
getFullPathName :: !String !*World -> (!MaybeOSError String, !*World)
implementation module System._FilePath
import _SystemArray
import StdInt
import Data.Error
import System.OSError
import System._Pointer
import System._Posix
getFullPathName :: !String !*World -> (!MaybeOSError String, !*World)
getFullPathName relp w
# buf = createArray MAXPATHLEN '\0'
# (res,w) = realpath (packString relp) buf w
| res == 0
= getLastOSError w
| otherwise
= (Ok (unpackString buf), w)
where
realpath :: !String !String !*World -> (!Pointer, !*World)
realpath path buf w = code {
ccall realpath "ss:p:A"
}
......@@ -12,4 +12,5 @@ HeapFree@12
CreatePipe@16
PeekNamedPipe@24
SetHandleInformation@12
TerminateProcess@8
\ No newline at end of file
TerminateProcess@8
GetFullPathNameA@16
......@@ -7,3 +7,4 @@ gmtime
localtime
mktime
strftime
_mkgmtime
\ No newline at end of file
......@@ -59,9 +59,15 @@ gmTime :: !*World -> (!Tm, !*World)
*/
localTime :: !*World -> (!Tm, !*World)
/**
* Convert a Tm record (local time) to a Timestamp value
* Convert a Tm record (local time) to a Timestamp value.
* This is not a pure function as it depends on the current local time zone.
*/
mkTime :: !Tm -> Timestamp
mkTime :: !Tm !*World-> (!Timestamp, !*World)
/**
* Convert a Tm record (UTC) to a Timestamp value.
* No time zone conversion is done.
*/
timeGm :: !Tm -> Timestamp
/**
* Calculate the difference in seconds between two times
*/
......
......@@ -74,14 +74,22 @@ localTime world
# (tm,world) = localTimeC (packInt t) world
= (derefTm tm, world)
mkTime :: !Tm -> Timestamp
mkTime tm
# t = mkTimeC (packTm tm)
= Timestamp t
where
mkTimeC :: !{#Int} -> Int
mkTimeC tm = code {
ccall mktime "A:I"
mkTime :: !Tm !*World-> (!Timestamp, !*World)
mkTime tm world
# (t, world) = mkTimeC (packTm tm) world
= (Timestamp t, world)
where
mkTimeC :: !{#Int} !*World -> (!Int, !*World)
mkTimeC tm world = code {
ccall mktime "A:I:I"
}
timeGm :: !Tm -> Timestamp
timeGm tm = Timestamp (timegmC (packTm tm))
where
timegmC :: !{#Int} -> Int
timegmC tm = code {
ccall _mkgmtime "A:I"
}
diffTime :: !Timestamp !Timestamp -> Int
......
definition module System._FilePath
from Data.Error import :: MaybeError
from System.OSError import :: MaybeOSError, :: OSError, :: OSErrorMessage, :: OSErrorCode
getFullPathName :: !String !*World -> (!MaybeOSError String, !*World)
implementation module System._FilePath
import _SystemArray
import Data.Error
import System.OSError
import System._Pointer
import System._Windows
getFullPathName :: !String !*World -> (!MaybeOSError String, !*World)
getFullPathName relp w
# buf = createArray MAX_PATH '\0'
# (res,w) = getFullPathNameA (packString relp) MAX_PATH buf NULL w
| res == 0
= getLastOSError w
| otherwise
= (Ok (unpackString buf), w)
......@@ -126,6 +126,8 @@ unlockFile :: !HANDLE !DWORD !DWORD !DWORD !DWORD !*w -> (!Bool, !*w)
getFileSize :: !HANDLE !LPDWORD !*w -> (!DWORD, !*w)
getFullPathNameA :: !String !DWORD !String !LPTSTR !*w -> (!DWORD, !*w)
createDirectoryA :: !String !LPSECURITY_ATTRIBUTES !*w -> (!Bool, !*w)
createProcessA :: !String !String !LPSECURITY_ATTRIBUTES !LPSECURITY_ATTRIBUTES !Bool !Int !LPVOID
......
......@@ -63,6 +63,12 @@ getFileSize hFile lpFileSizeHigh world
ccall GetFileSize@8 "PIA:I:I"
}
getFullPathNameA :: !String !DWORD !String !LPTSTR !*w -> (!DWORD, !*w)
getFullPathNameA lpFileName nBufferLnegth lpBuffer lpFilePart world
= code {
ccall GetFullPathNameA@16 "PsIsp:I:I"
}
createProcessA :: !String !String !LPSECURITY_ATTRIBUTES !LPSECURITY_ATTRIBUTES !Bool !Int !LPVOID
!LPCTSTR !LPSTARTUPINFO !LPPROCESS_INFORMATION !*w -> (!Bool,!*w)
createProcessA lpApplicationName commandLine lpProcessAttributes lpThreadAttributes inheritHandles creationFlags lpEnvironment
......
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