gf-3.9: Grammatical Framework

Safe HaskellNone
LanguageHaskell2010

GF.Support

Contents

Synopsis

Supporting infrastructure and system utilities

Source locations

class HasSourcePath a where Source #

Minimal complete definition

sourcePath

Methods

sourcePath :: a -> FilePath Source #

data L a Source #

Attaching location information

Constructors

L Location a 

Instances

Functor L Source # 

Methods

fmap :: (a -> b) -> L a -> L b #

(<$) :: a -> L b -> L a #

Show a => Show (L a) Source # 

Methods

showsPrec :: Int -> L a -> ShowS #

show :: L a -> String #

showList :: [L a] -> ShowS #

Pretty a => Pretty (L a) Source # 

Methods

pp :: L a -> Doc Source #

ppList :: [L a] -> Doc Source #

unLoc :: L a -> a Source #

noLoc :: a -> L a Source #

ppL :: (Pretty a1, Pretty a) => L a1 -> a -> Doc Source #

Command line options

Option types

data Phase Source #

Constructors

Preproc 
Convert 
Compile 
Link 

Instances

Eq Phase Source # 

Methods

(==) :: Phase -> Phase -> Bool #

(/=) :: Phase -> Phase -> Bool #

Ord Phase Source # 

Methods

compare :: Phase -> Phase -> Ordering #

(<) :: Phase -> Phase -> Bool #

(<=) :: Phase -> Phase -> Bool #

(>) :: Phase -> Phase -> Bool #

(>=) :: Phase -> Phase -> Bool #

max :: Phase -> Phase -> Phase #

min :: Phase -> Phase -> Phase #

Show Phase Source # 

Methods

showsPrec :: Int -> Phase -> ShowS #

show :: Phase -> String #

showList :: [Phase] -> ShowS #

newtype Dump Source #

Constructors

Dump Pass 

Instances

Eq Dump Source # 

Methods

(==) :: Dump -> Dump -> Bool #

(/=) :: Dump -> Dump -> Bool #

Ord Dump Source # 

Methods

compare :: Dump -> Dump -> Ordering #

(<) :: Dump -> Dump -> Bool #

(<=) :: Dump -> Dump -> Bool #

(>) :: Dump -> Dump -> Bool #

(>=) :: Dump -> Dump -> Bool #

max :: Dump -> Dump -> Dump #

min :: Dump -> Dump -> Dump #

Show Dump Source # 

Methods

showsPrec :: Int -> Dump -> ShowS #

show :: Dump -> String #

showList :: [Dump] -> ShowS #

data Pass Source #

Instances

Eq Pass Source # 

Methods

(==) :: Pass -> Pass -> Bool #

(/=) :: Pass -> Pass -> Bool #

Ord Pass Source # 

Methods

compare :: Pass -> Pass -> Ordering #

(<) :: Pass -> Pass -> Bool #

(<=) :: Pass -> Pass -> Bool #

(>) :: Pass -> Pass -> Bool #

(>=) :: Pass -> Pass -> Bool #

max :: Pass -> Pass -> Pass #

min :: Pass -> Pass -> Pass #

Show Pass Source # 

Methods

showsPrec :: Int -> Pass -> ShowS #

show :: Pass -> String #

showList :: [Pass] -> ShowS #

Option parsing

parseOptions Source #

Arguments

:: ErrorMonad err 
=> [String]

list of string arguments

-> err (Options, [FilePath]) 

parseModuleOptions Source #

Arguments

:: ErrorMonad err 
=> [String]

list of string arguments

-> err Options 

Option pretty-printing

optionsGFO :: Options -> [(String, Literal)] Source #

Pretty-print the options that are preserved in .gfo files.

optionsPGF :: Options -> [(String, Literal)] Source #

Pretty-print the options that are preserved in .pgf files.

Option manipulation

Checking specific options

flag :: (Flags -> a) -> Options -> a Source #

renameEncoding :: String -> String Source #

This is for bacward compatibility. Since GHC 6.12 we started using the native Unicode support in GHC but it uses different names for the code pages.

Setting specific options

Convenience methods for checking options

The Error monad

data Err a Source #

Like Maybe type with error msgs

Constructors

Ok a 
Bad String 

Instances

Monad Err Source # 

Methods

(>>=) :: Err a -> (a -> Err b) -> Err b #

(>>) :: Err a -> Err b -> Err b #

return :: a -> Err a #

fail :: String -> Err a #

Functor Err Source #

added 2/10/2003 by PEB

Methods

fmap :: (a -> b) -> Err a -> Err b #

(<$) :: a -> Err b -> Err a #

Applicative Err Source # 

Methods

pure :: a -> Err a #

(<*>) :: Err (a -> b) -> Err a -> Err b #

(*>) :: Err a -> Err b -> Err b #

(<*) :: Err a -> Err b -> Err a #

Alternative Err Source # 

Methods

empty :: Err a #

(<|>) :: Err a -> Err a -> Err a #

some :: Err a -> Err [a] #

many :: Err a -> Err [a] #

MonadPlus Err Source #

added by KJ

Methods

mzero :: Err a #

mplus :: Err a -> Err a -> Err a #

ErrorMonad Err Source # 

Methods

raise :: String -> Err a Source #

handle :: Err a -> (String -> Err a) -> Err a Source #

handle_ :: Err a -> Err a -> Err a Source #

Eq a => Eq (Err a) Source # 

Methods

(==) :: Err a -> Err a -> Bool #

(/=) :: Err a -> Err a -> Bool #

Read a => Read (Err a) Source # 
Show a => Show (Err a) Source # 

Methods

showsPrec :: Int -> Err a -> ShowS #

show :: Err a -> String #

showList :: [Err a] -> ShowS #

err :: (String -> b) -> (a -> b) -> Err a -> b Source #

Analogue of maybe

maybeErr :: ErrorMonad m => String -> Maybe a -> m a Source #

Add msg s to Maybe failures

testErr :: ErrorMonad m => Bool -> String -> m () Source #

fromErr :: a -> Err a -> a Source #

Analogue of fromMaybe

errIn :: ErrorMonad m => String -> m a -> m a Source #

lookupErr :: (ErrorMonad m, Eq a, Show a) => a -> [(a, b)] -> m b Source #

Error monad class

class (Functor m, Monad m) => ErrorMonad m where Source #

Minimal complete definition

raise, handle

Methods

raise :: String -> m a Source #

handle :: m a -> (String -> m a) -> m a Source #

handle_ :: m a -> m a -> m a Source #

Instances

ErrorMonad Err Source # 

Methods

raise :: String -> Err a Source #

handle :: Err a -> (String -> Err a) -> Err a Source #

handle_ :: Err a -> Err a -> Err a Source #

checks :: ErrorMonad m => [m a] -> m a Source #

liftErr :: ErrorMonad m => Err a -> m a Source #

Checking

checkUnique :: (Show a, Eq a) => [a] -> [String] Source #

unifyMaybeBy :: (Eq b, Monad m) => (a -> b) -> Maybe a -> Maybe a -> m (Maybe a) Source #

unifyMaybe :: (Eq a, Monad m) => Maybe a -> Maybe a -> m (Maybe a) Source #

this is what happens when matching two values in the same module

Monadic operations on lists and pairs

mapPairListM :: Monad m => ((a, b) -> m c) -> [(a, b)] -> m [(a, c)] Source #

mapPairsM :: Monad m => (b -> m c) -> [(a, b)] -> m [(a, c)] Source #

pairM :: Monad m => (b -> m c) -> (b, b) -> m (c, c) Source #

Binary search trees; now with FiniteMap

type BinTree a b = Map a b Source #

isInBinTree :: Ord a => a -> BinTree a b -> Bool Source #

lookupTree :: (ErrorMonad m, Ord a) => (a -> String) -> a -> BinTree a b -> m b Source #

lookupTreeManyAll :: Ord a => (a -> String) -> [BinTree a b] -> a -> [b] Source #

updateTree :: Ord a => (a, b) -> BinTree a b -> BinTree a b Source #

buildTree :: Ord a => [(a, b)] -> BinTree a b Source #

filterBinTree :: Ord a => (a -> b -> Bool) -> BinTree a b -> BinTree a b Source #

mapTree :: ((a, b) -> c) -> BinTree a b -> BinTree a c Source #

tree2list :: BinTree a b -> [(a, b)] Source #

Printing

(+++) :: String -> String -> String infixr 5 Source #

(++-) :: String -> String -> String infixr 5 Source #

(++++) :: String -> String -> String infixr 5 Source #

(+++++) :: String -> String -> String infixr 5 Source #

wrapLines :: Int -> String -> String Source #

Thomas Hallgren's wrap lines

Topological sorting

topoTest :: Ord a => [(a, [a])] -> Either [a] [[a]] Source #

Topological sorting with test of cyclicity

topoTest2 :: Ord a => [(a, [a])] -> Either [[a]] [[a]] Source #

Topological sorting with test of cyclicity, new version /TH 2012-06-26

Misc

ifNull :: b -> ([a] -> b) -> [a] -> b Source #

combinations :: [[a]] -> [[a]] Source #

combinations is the same as sequence!!! peb 30/5-04

done :: Monad m => m () Source #

return ()

iterFix :: Eq a => ([a] -> [a]) -> [a] -> [a] Source #

Fix point iterator (for computing e.g. transitive closures or reachability)

chunks :: Eq a => a -> [a] -> [[a]] Source #

chop into separator-separated parts

Files and IO

putIfVerb :: Output f => Options -> String -> f () Source #

GF files path and library path manipulation

type InitPath Source #

Arguments

 = String

the directory portion of a pathname

extendPathEnv :: MonadIO io => Options -> io [FilePath] Source #

extends the search path with the gfLibraryPath and gfGrammarPathVar environment variables. Returns only existing paths.

Error handling in the IO monad

type IOE a = IO a Source #

Was: newtype IOE a = IOE { appIOE :: IO (Err a) }

tryIOE :: IOE a -> IO (Err a) Source #

Catch exceptions caused by calls to raise or fail in the IO monad. To catch all IO exceptions, use try instead.

useIOE :: a -> IOE a -> IO a Source #

Print the error message and return a default value if the IO operation fails

maybeIO :: MonadIO f => IO a -> f (Maybe a) Source #

die :: String -> IO a Source #

Diagnostic output

class Monad m => Output m where Source #

Minimal complete definition

ePutStr, ePutStrLn, putStrE, putStrLnE

Instances

putPointE :: (MonadIO m, Output m) => Verbosity -> Options -> String -> m b -> m b Source #

ioErrorText :: IOError -> String Source #

Because GHC adds the confusing text "user error" for failures caused by calls to fail.

Timing

timeIt :: MonadIO m => m t -> m (Integer, t) Source #

File IO

Reused

class Monad m => MonadIO m where #

Monads in which IO computations may be embedded. Any monad built by applying a sequence of monad transformers to the IO monad will be an instance of this class.

Instances should satisfy the following laws, which state that liftIO is a transformer of monads:

Minimal complete definition

liftIO

Methods

liftIO :: IO a -> m a #

Lift a computation from the IO monad.

Instances

MonadIO IO 

Methods

liftIO :: IO a -> IO a #

MonadIO m => MonadIO (CGIT m) 

Methods

liftIO :: IO a -> CGIT m a #

MonadIO m => MonadIO (MaybeT m) 

Methods

liftIO :: IO a -> MaybeT m a #

MonadIO m => MonadIO (InputT m) 

Methods

liftIO :: IO a -> InputT m a #

MonadIO m => MonadIO (ListT m) 

Methods

liftIO :: IO a -> ListT m a #

(Error e, MonadIO m) => MonadIO (ErrorT e m) 

Methods

liftIO :: IO a -> ErrorT e m a #

MonadIO m => MonadIO (ExceptT e m) 

Methods

liftIO :: IO a -> ExceptT e m a #

MonadIO m => MonadIO (StateT s m) 

Methods

liftIO :: IO a -> StateT s m a #

MonadIO m => MonadIO (StateT s m) 

Methods

liftIO :: IO a -> StateT s m a #

(Monoid w, MonadIO m) => MonadIO (WriterT w m) 

Methods

liftIO :: IO a -> WriterT w m a #

(Monoid w, MonadIO m) => MonadIO (WriterT w m) 

Methods

liftIO :: IO a -> WriterT w m a #

MonadIO m => MonadIO (IdentityT * m) 

Methods

liftIO :: IO a -> IdentityT * m a #

MonadIO m => MonadIO (ReaderT * r m) 

Methods

liftIO :: IO a -> ReaderT * r m a #

MonadIO m => MonadIO (ContT * r m) 

Methods

liftIO :: IO a -> ContT * r m a #

(Monoid w, MonadIO m) => MonadIO (RWST r w s m) 

Methods

liftIO :: IO a -> RWST r w s m a #

(Monoid w, MonadIO m) => MonadIO (RWST r w s m) 

Methods

liftIO :: IO a -> RWST r w s m a #

liftErr :: ErrorMonad m => Err a -> m a Source #

Backwards compatible try and catch

catch :: IO a -> (IOError -> IO a) -> IO a Source #

try :: IO a -> IO (Either IOError a) Source #

Console IO

Changing which character encoding to use for console IO

setConsoleEncoding :: IO () Source #

Set the console encoding (for Windows, has no effect on Unix-like systems)

Console colors

Binary serialisation

class Binary t Source #

The Binary class provides put and get, methods to encode and decode a Haskell value to a lazy ByteString. It mirrors the Read and Show classes for textual representation of Haskell types, and is suitable for serialising Haskell values to disk, over the network.

For parsing and generating simple external binary formats (e.g. C structures), Binary may be used, but in general is not suitable for complex protocols. Instead use the Put and Get primitives directly.

Instances of Binary should satisfy the following property:

decode . encode == id

That is, the get and put methods should be the inverse of each other. A range of instances are provided for basic Haskell types.

Minimal complete definition

put, get

Instances

Binary Bool Source # 

Methods

put :: Bool -> Put

get :: Get Bool

Binary Char Source # 

Methods

put :: Char -> Put

get :: Get Char

Binary Double Source # 

Methods

put :: Double -> Put

get :: Get Double

Binary Float Source # 

Methods

put :: Float -> Put

get :: Get Float

Binary Int Source # 

Methods

put :: Int -> Put

get :: Get Int

Binary Int8 Source # 

Methods

put :: Int8 -> Put

get :: Get Int8

Binary Int16 Source # 

Methods

put :: Int16 -> Put

get :: Get Int16

Binary Int32 Source # 

Methods

put :: Int32 -> Put

get :: Get Int32

Binary Int64 Source # 

Methods

put :: Int64 -> Put

get :: Get Int64

Binary Integer Source # 

Methods

put :: Integer -> Put

get :: Get Integer

Binary Ordering Source # 

Methods

put :: Ordering -> Put

get :: Get Ordering

Binary Word Source # 

Methods

put :: Word -> Put

get :: Get Word

Binary Word8 Source # 

Methods

put :: Word8 -> Put

get :: Get Word8

Binary Word16 Source # 

Methods

put :: Word16 -> Put

get :: Get Word16

Binary Word32 Source # 

Methods

put :: Word32 -> Put

get :: Get Word32

Binary Word64 Source # 

Methods

put :: Word64 -> Put

get :: Get Word64

Binary () Source # 

Methods

put :: () -> Put

get :: Get ()

Binary ByteString Source # 

Methods

put :: ByteString -> Put

get :: Get ByteString

Binary ByteString Source # 

Methods

put :: ByteString -> Put

get :: Get ByteString

Binary IntSet Source # 

Methods

put :: IntSet -> Put

get :: Get IntSet

Binary RawIdent Source # 

Methods

put :: RawIdent -> Put

get :: Get RawIdent

Binary a => Binary [a] Source # 

Methods

put :: [a] -> Put

get :: Get [a]

Binary a => Binary (Maybe a) Source # 

Methods

put :: Maybe a -> Put

get :: Get (Maybe a)

(Binary a, Integral a) => Binary (Ratio a) Source # 

Methods

put :: Ratio a -> Put

get :: Get (Ratio a)

Binary e => Binary (IntMap e) Source # 

Methods

put :: IntMap e -> Put

get :: Get (IntMap e)

Binary e => Binary (Tree e) Source # 

Methods

put :: Tree e -> Put

get :: Get (Tree e)

Binary e => Binary (Seq e) Source # 

Methods

put :: Seq e -> Put

get :: Get (Seq e)

(Ord a, Binary a) => Binary (Set a) Source # 

Methods

put :: Set a -> Put

get :: Get (Set a)

Binary a => Binary (VersionTagged a) Source # 

Methods

put :: VersionTagged a -> Put

get :: Get (VersionTagged a)

(Binary a, Binary b) => Binary (Either a b) Source # 

Methods

put :: Either a b -> Put

get :: Get (Either a b)

(Binary a, Binary b) => Binary (a, b) Source # 

Methods

put :: (a, b) -> Put

get :: Get (a, b)

(Binary i, Ix i, Binary e, IArray UArray e) => Binary (UArray i e) Source # 

Methods

put :: UArray i e -> Put

get :: Get (UArray i e)

(Binary i, Ix i, Binary e) => Binary (Array i e) Source # 

Methods

put :: Array i e -> Put

get :: Get (Array i e)

(Ord k, Binary k, Binary e) => Binary (Map k e) Source # 

Methods

put :: Map k e -> Put

get :: Get (Map k e)

(Binary a, Binary b, Binary c) => Binary (a, b, c) Source # 

Methods

put :: (a, b, c) -> Put

get :: Get (a, b, c)

(Binary a, Binary b, Binary c, Binary d) => Binary (a, b, c, d) Source # 

Methods

put :: (a, b, c, d) -> Put

get :: Get (a, b, c, d)

(Binary a, Binary b, Binary c, Binary d, Binary e) => Binary (a, b, c, d, e) Source # 

Methods

put :: (a, b, c, d, e) -> Put

get :: Get (a, b, c, d, e)

(Binary a, Binary b, Binary c, Binary d, Binary e, Binary f) => Binary (a, b, c, d, e, f) Source # 

Methods

put :: (a, b, c, d, e, f) -> Put

get :: Get (a, b, c, d, e, f)

(Binary a, Binary b, Binary c, Binary d, Binary e, Binary f, Binary g) => Binary (a, b, c, d, e, f, g) Source # 

Methods

put :: (a, b, c, d, e, f, g) -> Put

get :: Get (a, b, c, d, e, f, g)

(Binary a, Binary b, Binary c, Binary d, Binary e, Binary f, Binary g, Binary h) => Binary (a, b, c, d, e, f, g, h) Source # 

Methods

put :: (a, b, c, d, e, f, g, h) -> Put

get :: Get (a, b, c, d, e, f, g, h)

(Binary a, Binary b, Binary c, Binary d, Binary e, Binary f, Binary g, Binary h, Binary i) => Binary (a, b, c, d, e, f, g, h, i) Source # 

Methods

put :: (a, b, c, d, e, f, g, h, i) -> Put

get :: Get (a, b, c, d, e, f, g, h, i)

(Binary a, Binary b, Binary c, Binary d, Binary e, Binary f, Binary g, Binary h, Binary i, Binary j) => Binary (a, b, c, d, e, f, g, h, i, j) Source # 

Methods

put :: (a, b, c, d, e, f, g, h, i, j) -> Put

get :: Get (a, b, c, d, e, f, g, h, i, j)

encode :: Binary a => a -> ByteString Source #

Encode a value using binary serialisation to a lazy ByteString.

decode :: Binary a => ByteString -> a Source #

Decode a value from a lazy ByteString, reconstructing the original structure.

encodeFile :: Binary a => FilePath -> a -> IO () Source #

Lazily serialise a value to a file

This is just a convenience function, it's defined simply as:

encodeFile f = B.writeFile f . encode

So for example if you wanted to compress as well, you could use:

B.writeFile f . compress . encode

decodeFile :: Binary a => FilePath -> IO a Source #

Lazily reconstruct a value previously written to a file.

This is just a convenience function, it's defined simply as:

decodeFile f = return . decode =<< B.readFile f

So for example if you wanted to decompress as well, you could use:

return . decode . decompress =<< B.readFile f