terminfo-hs 0.1.0.1 → 0.2.0
raw patch · 13 files changed
+995/−963 lines, 13 filesdep +terminfo-hsdep ~attoparsecdep ~basedep ~bytestringPVP ok
version bump matches the API change (PVP)
Dependencies added: terminfo-hs
Dependency ranges changed: attoparsec, base, bytestring, containers, directory, errors, filepath
API changes (from Hackage documentation)
+ System.Terminfo.Internal: locationsPure :: Maybe FilePath -> Maybe FilePath -> Maybe String -> [FilePath] -> [FilePath]
+ System.Terminfo.Internal: parseTDVar :: [String] -> String -> [String]
+ System.Terminfo.Internal: terminfoDBLocs :: IO [FilePath]
Files
- System/Terminfo.hs +0/−162
- System/Terminfo/Caps.hs +0/−519
- System/Terminfo/DBParse.hs +0/−126
- System/Terminfo/Internal.hs +0/−67
- System/Terminfo/Types.hs +0/−20
- src/System/Terminfo.hs +178/−0
- src/System/Terminfo/Caps.hs +519/−0
- src/System/Terminfo/DBParse.hs +129/−0
- src/System/Terminfo/Internal.hs +70/−0
- src/System/Terminfo/Types.hs +20/−0
- terminfo-hs.cabal +35/−27
- test.hs +0/−42
- test/test.hs +44/−0
− System/Terminfo.hs
@@ -1,162 +0,0 @@--- |--- Module : System.Terminfo--- Copyright : (c) Bryan Richter (2013)--- License : BSD-style--- Maintainer : bryan.richter@gmail.com------ This is a pure-Haskell (no FFI) module for accessing terminfo databases,--- which contain characteristics, or capabilities, for the various--- terminals such as screen, vt100, or xterm. Among other things, the--- capabilities include the idiosyncratic character sequences needed to--- send commands to the terminal. These commands include things like cursor--- movement.------ For a deeper understanding of terminfo, consult the man pages for--- term(5) and terminfo(5).------ There are three parts to this module: acquiring a terminfo database,--- querying the database, and defining the capabilities.------ This module is dead simple, so a single example will hopefully suffice--- to demonstrate its usage.------ @--- import System.Terminfo--- import System.Terminfo.Caps as C--- uglyExample :: IO (Maybe Int)--- uglyExample = do--- term \<- fromJust \<$> lookupEnv \"TERM\"--- db \<- 'acquireDatabase' term--- let maxColors (Right d) = 'queryNumTermCap' d C.'MaxColors'--- return $ maxColors db--- @------ >>> uglyExample--- Just 256-----module System.Terminfo (- -- * Acquiring a Database- acquireDatabase- -- * Querying Capabilities- -- $queryFuncs- , queryBoolTermCap- , queryNumTermCap- , queryStrTermCap- -- * The Capabilities- -- $capabilities-- -- * The Database Type- , TIDatabase-- ) where--import Control.Applicative ((<$>), (<|>))-import Control.Error-import Control.Monad ((<=<), filterM)-import qualified Data.ByteString as B-import qualified Data.Map.Lazy as M-import System.Directory-import System.FilePath-import System.IO--import System.Terminfo.Types-import System.Terminfo.DBParse-import System.Terminfo.Internal (terminfoDBLocs)-import System.Terminfo.Caps--data DBType = BerkeleyDB | DirTreeDB- deriving(Show)---- Old MacDonald had a farm...-type EIO = EitherT String IO--acquireDatabase- :: String -- ^ System name- -> IO (Either String TIDatabase)- -- ^ A database object for the terminal, if it exists.-acquireDatabase = runEitherT . (parseDBFile <=< findDBFile)--findDBFile :: String -> EIO (DBType, FilePath)-findDBFile term = case term of- (c:_) -> dbFileM c term `orLeft` "No terminfo db found"- _ -> hoistEither $ Left "User specified null terminal name"- where- orLeft = flip noteT- dbFileM c t = dirTreeDB c t <|> berkeleyDB---- | Not implemented-berkeleyDB :: MaybeT IO (DBType, FilePath)-berkeleyDB = nothing--dirTreeDB :: Char -> String -> MaybeT IO (DBType, FilePath)-dirTreeDB c term = MaybeT $ do- path <- findFirst =<< map (</> [c] </> term) <$> terminfoDBLocs- return $ (,) DirTreeDB <$> path--findFirst :: [FilePath] -> IO (Maybe FilePath)-findFirst = fmap headMay . filterM doesFileExist--parseDBFile :: (DBType, FilePath) -> EIO TIDatabase-parseDBFile (db, f) = case db of- DirTreeDB -> extractDirTreeDB f- BerkeleyDB -> hoistEither- $ Left "BerkeleyDB support not yet implemented"---- | Extract a 'TIDatabase' from the specified file. IO exceptions are--- left to their own devices.-extractDirTreeDB :: FilePath- -> EIO TIDatabase-extractDirTreeDB =- hoistEither . parseDB- <=< rightT . B.hGetContents- <=< rightT . flip openBinaryFile ReadMode- where- rightT = EitherT . fmap Right--queryBoolTermCap :: TIDatabase- -> BoolTermCap- -> Bool-queryBoolTermCap (TIDatabase (TCBMap vals) _ _) cap =- fromMaybe False $ M.lookup cap vals--queryNumTermCap :: TIDatabase- -> NumTermCap- -> Maybe Int-queryNumTermCap (TIDatabase _ (TCNMap vals) _) cap = M.lookup cap vals---- | As this is a dead simple module, no \'smart\' handling of the--- returned string is implemented. In particular, placeholders for--- buffer characters and command arguments are left as-is. This will be--- rectified eventually, probably in a separate module.-queryStrTermCap :: TIDatabase- -> StrTermCap- -> Maybe String-queryStrTermCap (TIDatabase _ _ (TCSMap vals)) cap = M.lookup cap vals------- DOCUMENTATION--------- $queryFuncs------ For each of these three actions, the first argument is the database to--- query, and the second argument is the capability to look up.------ I'm not super proud of this interface, but it's the best I can manage at--- present without requiring lots of mostly-empty case expressions. Perhaps--- someone will suggest a more interesting solution.---- $capabilities------ /see/ "System.Terminfo.Caps"------ There are no less than 497 capabilities specified in term.h on my--- Intel-based Ubuntu 12.04 notebook (slightly fewer in the terminfo(5) man--- page). The naive way of making these available to the user is as data--- constructors, and that is what I have done here.------ The number of constructors absolutely crushes the namespace. I have--- sequestered them into their own module to try to alleviate the pain.
− System/Terminfo/Caps.hs
@@ -1,519 +0,0 @@--- | There is an egregious number of capabilities. They are sequestered in--- this module to preserve namespace sanity.------ For descriptions of these, consult terminfo(5).--module System.Terminfo.Caps (- -- * Boolean- BoolTermCap(..)- -- * Numeric- , NumTermCap(..)- -- * String- , StrTermCap(..)- ) where--data BoolTermCap- = AutoLeftMargin- | AutoRightMargin- | NoEscCtlc- | CeolStandoutGlitch- | EatNewlineGlitch- | EraseOverstrike- | GenericType- | HardCopy- | HasMetaKey- | HasStatusLine- | InsertNullGlitch- | MemoryAbove- | MemoryBelow- | MoveInsertMode- | MoveStandoutMode- | OverStrike- | StatusLineEscOk- | DestTabsMagicSmso- | TildeGlitch- | TransparentUnderline- | XonXoff- | NeedsXonXoff- | PrtrSilent- | HardCursor- | NonRevRmcup- | NoPadChar- | NonDestScrollRegion- | CanChange- | BackColorErase- | HueLightnessSaturation- | ColAddrGlitch- | CrCancelsMicroMode- | HasPrintWheel- | RowAddrGlitch- | SemiAutoRightMargin- | CpiChangesRes- | LpiChangesRes- | BackspacesWithBs- | CrtNoScrolling- | NoCorrectlyWorkingCr- | GnuHasMetaKey- | LinefeedIsNewline- | HasHardwareTabs- | ReturnDoesClrEol- deriving (Ord, Eq, Enum, Bounded, Show)--data NumTermCap- = Columns- | InitTabs- | Lines- | LinesOfMemory- | MagicCookieGlitch- | PaddingBaudRate- | VirtualTerminal- | WidthStatusLine- | NumLabels- | LabelHeight- | LabelWidth- | MaxAttributes- | MaximumWindows- | MaxColors- | MaxPairs- | NoColorVideo- | BufferCapacity- | DotVertSpacing- | DotHorzSpacing- | MaxMicroAddress- | MaxMicroJump- | MicroColSize- | MicroLineSize- | NumberOfPins- | OutputResChar- | OutputResLine- | OutputResHorzInch- | OutputResVertInch- | PrintRate- | WideCharSize- | Buttons- | BitImageEntwining- | BitImageType- | MagicCookieGlitchUl- | CarriageReturnDelay- | NewLineDelay- | BackspaceDelay- | HorizontalTabDelay- | NumberOfFunctionKeys- deriving (Ord, Eq, Enum, Bounded, Show)--data StrTermCap- = BackTab- | Bell- | CarriageReturn- | ChangeScrollRegion- | ClearAllTabs- | ClearScreen- | ClrEol- | ClrEos- | ColumnAddress- | CommandCharacter- | CursorAddress- | CursorDown- | CursorHome- | CursorInvisible- | CursorLeft- | CursorMemAddress- | CursorNormal- | CursorRight- | CursorToLl- | CursorUp- | CursorVisible- | DeleteCharacter- | DeleteLine- | DisStatusLine- | DownHalfLine- | EnterAltCharsetMode- | EnterBlinkMode- | EnterBoldMode- | EnterCaMode- | EnterDeleteMode- | EnterDimMode- | EnterInsertMode- | EnterSecureMode- | EnterProtectedMode- | EnterReverseMode- | EnterStandoutMode- | EnterUnderlineMode- | EraseChars- | ExitAltCharsetMode- | ExitAttributeMode- | ExitCaMode- | ExitDeleteMode- | ExitInsertMode- | ExitStandoutMode- | ExitUnderlineMode- | FlashScreen- | FormFeed- | FromStatusLine- | Init1string- | Init2string- | Init3string- | InitFile- | InsertCharacter- | InsertLine- | InsertPadding- | KeyBackspace- | KeyCatab- | KeyClear- | KeyCtab- | KeyDc- | KeyDl- | KeyDown- | KeyEic- | KeyEol- | KeyEos- | KeyF0- | KeyF1- | KeyF10- | KeyF2- | KeyF3- | KeyF4- | KeyF5- | KeyF6- | KeyF7- | KeyF8- | KeyF9- | KeyHome- | KeyIc- | KeyIl- | KeyLeft- | KeyLl- | KeyNpage- | KeyPpage- | KeyRight- | KeySf- | KeySr- | KeyStab- | KeyUp- | KeypadLocal- | KeypadXmit- | LabF0- | LabF1- | LabF10- | LabF2- | LabF3- | LabF4- | LabF5- | LabF6- | LabF7- | LabF8- | LabF9- | MetaOff- | MetaOn- | Newline- | PadChar- | ParmDch- | ParmDeleteLine- | ParmDownCursor- | ParmIch- | ParmIndex- | ParmInsertLine- | ParmLeftCursor- | ParmRightCursor- | ParmRindex- | ParmUpCursor- | PkeyKey- | PkeyLocal- | PkeyXmit- | PrintScreen- | PrtrOff- | PrtrOn- | RepeatChar- | Reset1string- | Reset2string- | Reset3string- | ResetFile- | RestoreCursor- | RowAddress- | SaveCursor- | ScrollForward- | ScrollReverse- | SetAttributes- | SetTab- | SetWindow- | Tab- | ToStatusLine- | UnderlineChar- | UpHalfLine- | InitProg- | KeyA1- | KeyA3- | KeyB2- | KeyC1- | KeyC3- | PrtrNon- | CharPadding- | AcsChars- | PlabNorm- | KeyBtab- | EnterXonMode- | ExitXonMode- | EnterAmMode- | ExitAmMode- | XonCharacter- | XoffCharacter- | EnaAcs- | LabelOn- | LabelOff- | KeyBeg- | KeyCancel- | KeyClose- | KeyCommand- | KeyCopy- | KeyCreate- | KeyEnd- | KeyEnter- | KeyExit- | KeyFind- | KeyHelp- | KeyMark- | KeyMessage- | KeyMove- | KeyNext- | KeyOpen- | KeyOptions- | KeyPrevious- | KeyPrint- | KeyRedo- | KeyReference- | KeyRefresh- | KeyReplace- | KeyRestart- | KeyResume- | KeySave- | KeySuspend- | KeyUndo- | KeySbeg- | KeyScancel- | KeyScommand- | KeyScopy- | KeyScreate- | KeySdc- | KeySdl- | KeySelect- | KeySend- | KeySeol- | KeySexit- | KeySfind- | KeyShelp- | KeyShome- | KeySic- | KeySleft- | KeySmessage- | KeySmove- | KeySnext- | KeySoptions- | KeySprevious- | KeySprint- | KeySredo- | KeySreplace- | KeySright- | KeySrsume- | KeySsave- | KeySsuspend- | KeySundo- | ReqForInput- | KeyF11- | KeyF12- | KeyF13- | KeyF14- | KeyF15- | KeyF16- | KeyF17- | KeyF18- | KeyF19- | KeyF20- | KeyF21- | KeyF22- | KeyF23- | KeyF24- | KeyF25- | KeyF26- | KeyF27- | KeyF28- | KeyF29- | KeyF30- | KeyF31- | KeyF32- | KeyF33- | KeyF34- | KeyF35- | KeyF36- | KeyF37- | KeyF38- | KeyF39- | KeyF40- | KeyF41- | KeyF42- | KeyF43- | KeyF44- | KeyF45- | KeyF46- | KeyF47- | KeyF48- | KeyF49- | KeyF50- | KeyF51- | KeyF52- | KeyF53- | KeyF54- | KeyF55- | KeyF56- | KeyF57- | KeyF58- | KeyF59- | KeyF60- | KeyF61- | KeyF62- | KeyF63- | ClrBol- | ClearMargins- | SetLeftMargin- | SetRightMargin- | LabelFormat- | SetClock- | DisplayClock- | RemoveClock- | CreateWindow- | GotoWindow- | Hangup- | DialPhone- | QuickDial- | Tone- | Pulse- | FlashHook- | FixedPause- | WaitTone- | User0- | User1- | User2- | User3- | User4- | User5- | User6- | User7- | User8- | User9- | OrigPair- | OrigColors- | InitializeColor- | InitializePair- | SetColorPair- | SetForeground- | SetBackground- | ChangeCharPitch- | ChangeLinePitch- | ChangeResHorz- | ChangeResVert- | DefineChar- | EnterDoublewideMode- | EnterDraftQuality- | EnterItalicsMode- | EnterLeftwardMode- | EnterMicroMode- | EnterNearLetterQuality- | EnterNormalQuality- | EnterShadowMode- | EnterSubscriptMode- | EnterSuperscriptMode- | EnterUpwardMode- | ExitDoublewideMode- | ExitItalicsMode- | ExitLeftwardMode- | ExitMicroMode- | ExitShadowMode- | ExitSubscriptMode- | ExitSuperscriptMode- | ExitUpwardMode- | MicroColumnAddress- | MicroDown- | MicroLeft- | MicroRight- | MicroRowAddress- | MicroUp- | OrderOfPins- | ParmDownMicro- | ParmLeftMicro- | ParmRightMicro- | ParmUpMicro- | SelectCharSet- | SetBottomMargin- | SetBottomMarginParm- | SetLeftMarginParm- | SetRightMarginParm- | SetTopMargin- | SetTopMarginParm- | StartBitImage- | StartCharSetDef- | StopBitImage- | StopCharSetDef- | SubscriptCharacters- | SuperscriptCharacters- | TheseCauseCr- | ZeroMotion- | CharSetNames- | KeyMouse- | MouseInfo- | ReqMousePos- | GetMouse- | SetAForeground- | SetABackground- | PkeyPlab- | DeviceType- | CodeSetInit- | Set0DesSeq- | Set1DesSeq- | Set2DesSeq- | Set3DesSeq- | SetLrMargin- | SetTbMargin- | BitImageRepeat- | BitImageNewline- | BitImageCarriageReturn- | ColorNames- | DefineBitImageRegion- | EndBitImageRegion- | SetColorBand- | SetPageLength- | DisplayPcChar- | EnterPcCharsetMode- | ExitPcCharsetMode- | EnterScancodeMode- | ExitScancodeMode- | PcTermOptions- | ScancodeEscape- | AltScancodeEsc- | EnterHorizontalHlMode- | EnterLeftHlMode- | EnterLowHlMode- | EnterRightHlMode- | EnterTopHlMode- | EnterVerticalHlMode- | SetAAttributes- | SetPglenInch- | TermcapInit2- | TermcapReset- | LinefeedIfNotLf- | BackspaceIfNotBs- | OtherNonFunctionKeys- | ArrowKeyMap- | AcsUlcorner- | AcsLlcorner- | AcsUrcorner- | AcsLrcorner- | AcsLtee- | AcsRtee- | AcsBtee- | AcsTtee- | AcsHline- | AcsVline- | AcsPlus- | MemoryLock- | MemoryUnlock- | BoxChars1- deriving (Ord, Eq, Enum, Bounded, Show)
− System/Terminfo/DBParse.hs
@@ -1,126 +0,0 @@-{-# LANGUAGE RecordWildCards #-}---- |--- Module : System.Terminfo.DBParse--- Copyright : (c) Bryan Richter (2013)--- License : BSD-style--- --- Maintainer : bryan.richter@gmail.com------ An internal module encapsulating methods for parsing a terminfo file as--- generated by tic(1). The primary reference is the term(5) manpage.-----module System.Terminfo.DBParse- ( parseDB- ) where--import Control.Applicative ((<$>), (<*>))-import Control.Arrow ((***))-import qualified Control.Arrow as Arr-import Control.Monad ((<=<), when, void)-import Data.Attoparsec as A-import Data.ByteString (ByteString)-import qualified Data.ByteString as B-import Data.Char (chr)-import qualified Data.Map.Lazy as M-import Data.Word (Word16)--import System.Terminfo.Types---- | term(5) defines a short integer as two 8-bit bytes, so:-type ShortInt = Word16---- | short ints are stored little-endian.-shortInt :: Integral a => ShortInt -> Parser a-shortInt i = word8 first >> word8 second >> return (fromIntegral i)- where- (second, first) = (fromIntegral *** fromIntegral) $ i `divMod` 256---- | short ints are stored little-endian.------ (-1) is represented by the two bytes 0o377 0o377.------ Return type is Int so I can include (-1) in the possible outputs. I--- wonder if I will regret this.-anyShortInt :: Parser Int-anyShortInt = do- first <- fromIntegral <$> anyWord8- second <- fromIntegral <$> anyWord8- return $ if first == 0o377 && second == 0o377- then (-1)- else 256*second + first--parseDB :: ByteString -> Either String TIDatabase-parseDB = parseOnly tiDatabase--tiDatabase :: Parser TIDatabase-tiDatabase = do- Header{..} <- header- -- Ignore names- _ <- A.take namesSize- bools <- boolCaps boolSize- -- Align on an even byte- when (odd boolSize) (void $ A.take 1)- nums <- numCaps numIntegers- strs <- stringCaps numOffsets stringSize- -- TODO: extended info- return $ TIDatabase bools nums strs--boolCaps :: Int -- ^ Number of caps- -> Parser TCBMap-boolCaps =- return . TCBMap . M.fromList . zip keys . map (== 1) . B.unpack- <=< A.take- where- {-keys :: [BoolTermCap]-}- keys = [minBound ..]---- Negative values indicate missing capability.-numCaps :: Int -- ^ Number of caps- -> Parser TCNMap-numCaps = return . TCNMap . M.fromList . filter notNeg . zip keys- <=< flip A.count anyShortInt- where- notNeg = ((/= -1) . snd)- {-keys :: [BoolTermCap]-}- keys = [minBound ..]--stringCaps :: Int -- ^ Number of caps- -> Int -- ^ Size of table- -> Parser TCSMap-stringCaps numOffsets stringSize = do- offs <- A.count numOffsets anyShortInt- stringTable <- A.take stringSize- return- $ TCSMap $ M.fromList $ map (parseValue stringTable)- $ filter notNeg $ zip keys offs- where- notNeg = ((/= -1) . snd)- keys = [minBound ..]- parseValue tbl = Arr.second $ parseString tbl- parseString table offset =- asString- $ B.takeWhile (/= 0) -- null-terminated- $ B.drop offset table -- starts at offset- asString = map (chr . fromIntegral) . B.unpack---- | the magic number for term files-magic :: Parser Int-magic = shortInt 0o432 <?> "Not a terminfo file (bad magic)"--data Header = Header- { namesSize :: Int- , boolSize :: Int- , numIntegers :: Int- , numOffsets :: Int- , stringSize :: Int- }- deriving (Show)--header :: Parser Header-header = magic >> Header <$> anyShortInt- <*> anyShortInt- <*> anyShortInt- <*> anyShortInt- <*> anyShortInt
− System/Terminfo/Internal.hs
@@ -1,67 +0,0 @@-module System.Terminfo.Internal- ( terminfoDBLocs- , locationsPure- , parseTDVar- ) where--import Control.Applicative ((<$>), (<*>), pure)-import Control.Error-import System.Environment (lookupEnv)-import System.FilePath--terminfoDBLocs :: IO [FilePath]-terminfoDBLocs = locationsPure- <$> lookupEnv "TERMINFO"- <*> (lookupEnv "HOME" <$$/> ".terminfo")- <*> lookupEnv "TERMINFO_DIRS"- <*> pure ["/lib/terminfo", "/usr/share/terminfo"]---(<$/>) :: Functor f => f FilePath -> FilePath -> f FilePath-fa <$/> b = (</> b) <$> fa-infixr 4 <$/>--(<$$/>) :: (Functor f, Functor g)- => f (g FilePath)- -> FilePath- -> f (g FilePath)-ffa <$$/> b = fmap (<$/> b) ffa-infixr 4 <$$/>---- | I hate this name. There is undoubtedly a better way of structuring all--- of this, starting way up at 'dirTreeDB'.-locationsPure :: Maybe FilePath -- ^ Override directory- -> Maybe FilePath -- ^ $HOME- -> Maybe String -- ^ $TERMINFO_DIRS- -> [FilePath] -- ^ Defaults- -> [FilePath]-locationsPure ovr usr termdirs defs = case ovr of- Just override -> [override]- Nothing -> catMaybes [usr] ++ system-- where- system = case termdirs of- Just list -> parseTDVar defs list- Nothing -> defs--parseTDVar :: [String] -> String -> [String]-parseTDVar defs = replace "" defs . split ':'---- | Replace an element with multiple replacements-replace :: Eq a => a -> [a] -> [a] -> [a]-replace old news = foldr (\x acc -> if x == old- then news ++ acc- else x : acc)- []---- | split, as seen in ByteString and Text, but for Strings.-split :: Char -> String -> [String]-split s = foldr go [[]]- where- go c acc = if c /= s- then unshift c acc- else "" : acc-- -- | /perldoc -f unshift/- unshift c (xs:xss) = (c:xs) : xss- unshift c [] = [[c]]
− System/Terminfo/Types.hs
@@ -1,20 +0,0 @@-module System.Terminfo.Types- ( TIDatabase(..)- , TCBMap(..)- , TCNMap(..)- , TCSMap(..)- ) where--import Data.Map.Lazy (Map)--import System.Terminfo.Caps--data TCBMap = TCBMap (Map BoolTermCap Bool)- deriving (Show)-data TCNMap = TCNMap (Map NumTermCap Int)- deriving (Show)-data TCSMap = TCSMap (Map StrTermCap String)- deriving (Show)--data TIDatabase = TIDatabase TCBMap TCNMap TCSMap- deriving (Show)
+ src/System/Terminfo.hs view
@@ -0,0 +1,178 @@+{-# LANGUAGE CPP #-}+-- |+-- Module : System.Terminfo+-- Copyright : (c) Bryan Richter (2013)+-- License : BSD-style+-- Maintainer : bryan.richter@gmail.com+--+-- This is a pure-Haskell (no FFI) module for accessing terminfo databases,+-- which contain characteristics, or capabilities, for the various+-- terminals such as screen, vt100, or xterm. Among other things, the+-- capabilities include the idiosyncratic character sequences needed to+-- send commands to the terminal. These commands include things like cursor+-- movement.+--+-- For a deeper understanding of terminfo, consult the man pages for+-- term(5) and terminfo(5).+--+-- There are three parts to this module: acquiring a terminfo database,+-- querying the database, and defining the capabilities.+--+-- This module is dead simple, so a single example will hopefully suffice+-- to demonstrate its usage.+--+-- @+-- import System.Terminfo+-- import System.Terminfo.Caps as C+-- uglyExample :: IO (Maybe Int)+-- uglyExample = do+-- term \<- fromJust \<$> lookupEnv \"TERM\"+-- db \<- 'acquireDatabase' term+-- let maxColors (Right d) = 'queryNumTermCap' d C.'MaxColors'+-- return $ maxColors db+-- @+--+-- >>> uglyExample+-- Just 256+--++module System.Terminfo (+ -- * Acquiring a Database+ acquireDatabase+ -- * Querying Capabilities+ -- $queryFuncs+ , queryBoolTermCap+ , queryNumTermCap+ , queryStrTermCap+ -- * The Capabilities+ -- $capabilities++ -- * The Database Type+ , TIDatabase++ ) where++#if MIN_VERSION_base(4,8,0)+import Control.Applicative ((<|>))+#else+import Control.Applicative ((<$>), (<|>))+#endif+import Control.Error+import Control.Monad ((<=<), filterM)+import qualified Data.ByteString as B+import qualified Data.Map.Lazy as M+import System.Directory+import System.FilePath+import System.IO++import System.Terminfo.Types+import System.Terminfo.DBParse+import System.Terminfo.Internal (terminfoDBLocs)+import System.Terminfo.Caps++#if MIN_VERSION_base(4,8,0)+except :: m (Either e a) -> ExceptT e m a+except = ExceptT+#else+type ExceptT = EitherT+runExceptT :: EitherT e m a -> m (Either e a)+runExceptT = runEitherT+except :: m (Either e a) -> EitherT e m a+except = EitherT+#endif++data DBType = BerkeleyDB | DirTreeDB+ deriving(Show)++-- Old MacDonald had a farm...+type EIO = ExceptT String IO++acquireDatabase+ :: String -- ^ System name+ -> IO (Either String TIDatabase)+ -- ^ A database object for the terminal, if it exists.+acquireDatabase = runExceptT . (parseDBFile <=< findDBFile)++findDBFile :: String -> EIO (DBType, FilePath)+findDBFile term = case term of+ (c:_) -> dbFileM c term `orLeft` "No terminfo db found"+ _ -> hoistEither $ Left "User specified null terminal name"+ where+ orLeft = flip noteT+ dbFileM c t = dirTreeDB c t <|> berkeleyDB++-- | Not implemented+berkeleyDB :: MaybeT IO (DBType, FilePath)+berkeleyDB = nothing++dirTreeDB :: Char -> String -> MaybeT IO (DBType, FilePath)+dirTreeDB c term = MaybeT $ do+ path <- findFirst =<< map (</> [c] </> term) <$> terminfoDBLocs+ return $ (,) DirTreeDB <$> path++findFirst :: [FilePath] -> IO (Maybe FilePath)+findFirst = fmap headMay . filterM doesFileExist++parseDBFile :: (DBType, FilePath) -> EIO TIDatabase+parseDBFile (db, f) = case db of+ DirTreeDB -> extractDirTreeDB f+ BerkeleyDB -> hoistEither+ $ Left "BerkeleyDB support not yet implemented"++-- | Extract a 'TIDatabase' from the specified file. IO exceptions are+-- left to their own devices.+extractDirTreeDB :: FilePath+ -> EIO TIDatabase+extractDirTreeDB =+ hoistEither . parseDB+ <=< rightT . B.hGetContents+ <=< rightT . flip openBinaryFile ReadMode+ where+ rightT = except . fmap Right++queryBoolTermCap :: TIDatabase+ -> BoolTermCap+ -> Bool+queryBoolTermCap (TIDatabase (TCBMap vals) _ _) cap =+ fromMaybe False $ M.lookup cap vals++queryNumTermCap :: TIDatabase+ -> NumTermCap+ -> Maybe Int+queryNumTermCap (TIDatabase _ (TCNMap vals) _) cap = M.lookup cap vals++-- | As this is a dead simple module, no \'smart\' handling of the+-- returned string is implemented. In particular, placeholders for+-- buffer characters and command arguments are left as-is. This will be+-- rectified eventually, probably in a separate module.+queryStrTermCap :: TIDatabase+ -> StrTermCap+ -> Maybe String+queryStrTermCap (TIDatabase _ _ (TCSMap vals)) cap = M.lookup cap vals++--+-- DOCUMENTATION+--++++-- $queryFuncs+--+-- For each of these three actions, the first argument is the database to+-- query, and the second argument is the capability to look up.+--+-- I'm not super proud of this interface, but it's the best I can manage at+-- present without requiring lots of mostly-empty case expressions. Perhaps+-- someone will suggest a more interesting solution.++-- $capabilities+--+-- /see/ "System.Terminfo.Caps"+--+-- There are no less than 497 capabilities specified in term.h on my+-- Intel-based Ubuntu 12.04 notebook (slightly fewer in the terminfo(5) man+-- page). The naive way of making these available to the user is as data+-- constructors, and that is what I have done here.+--+-- The number of constructors absolutely crushes the namespace. I have+-- sequestered them into their own module to try to alleviate the pain.
+ src/System/Terminfo/Caps.hs view
@@ -0,0 +1,519 @@+-- | There is an egregious number of capabilities. They are sequestered in+-- this module to preserve namespace sanity.+--+-- For descriptions of these, consult terminfo(5).++module System.Terminfo.Caps (+ -- * Boolean+ BoolTermCap(..)+ -- * Numeric+ , NumTermCap(..)+ -- * String+ , StrTermCap(..)+ ) where++data BoolTermCap+ = AutoLeftMargin+ | AutoRightMargin+ | NoEscCtlc+ | CeolStandoutGlitch+ | EatNewlineGlitch+ | EraseOverstrike+ | GenericType+ | HardCopy+ | HasMetaKey+ | HasStatusLine+ | InsertNullGlitch+ | MemoryAbove+ | MemoryBelow+ | MoveInsertMode+ | MoveStandoutMode+ | OverStrike+ | StatusLineEscOk+ | DestTabsMagicSmso+ | TildeGlitch+ | TransparentUnderline+ | XonXoff+ | NeedsXonXoff+ | PrtrSilent+ | HardCursor+ | NonRevRmcup+ | NoPadChar+ | NonDestScrollRegion+ | CanChange+ | BackColorErase+ | HueLightnessSaturation+ | ColAddrGlitch+ | CrCancelsMicroMode+ | HasPrintWheel+ | RowAddrGlitch+ | SemiAutoRightMargin+ | CpiChangesRes+ | LpiChangesRes+ | BackspacesWithBs+ | CrtNoScrolling+ | NoCorrectlyWorkingCr+ | GnuHasMetaKey+ | LinefeedIsNewline+ | HasHardwareTabs+ | ReturnDoesClrEol+ deriving (Ord, Eq, Enum, Bounded, Show)++data NumTermCap+ = Columns+ | InitTabs+ | Lines+ | LinesOfMemory+ | MagicCookieGlitch+ | PaddingBaudRate+ | VirtualTerminal+ | WidthStatusLine+ | NumLabels+ | LabelHeight+ | LabelWidth+ | MaxAttributes+ | MaximumWindows+ | MaxColors+ | MaxPairs+ | NoColorVideo+ | BufferCapacity+ | DotVertSpacing+ | DotHorzSpacing+ | MaxMicroAddress+ | MaxMicroJump+ | MicroColSize+ | MicroLineSize+ | NumberOfPins+ | OutputResChar+ | OutputResLine+ | OutputResHorzInch+ | OutputResVertInch+ | PrintRate+ | WideCharSize+ | Buttons+ | BitImageEntwining+ | BitImageType+ | MagicCookieGlitchUl+ | CarriageReturnDelay+ | NewLineDelay+ | BackspaceDelay+ | HorizontalTabDelay+ | NumberOfFunctionKeys+ deriving (Ord, Eq, Enum, Bounded, Show)++data StrTermCap+ = BackTab+ | Bell+ | CarriageReturn+ | ChangeScrollRegion+ | ClearAllTabs+ | ClearScreen+ | ClrEol+ | ClrEos+ | ColumnAddress+ | CommandCharacter+ | CursorAddress+ | CursorDown+ | CursorHome+ | CursorInvisible+ | CursorLeft+ | CursorMemAddress+ | CursorNormal+ | CursorRight+ | CursorToLl+ | CursorUp+ | CursorVisible+ | DeleteCharacter+ | DeleteLine+ | DisStatusLine+ | DownHalfLine+ | EnterAltCharsetMode+ | EnterBlinkMode+ | EnterBoldMode+ | EnterCaMode+ | EnterDeleteMode+ | EnterDimMode+ | EnterInsertMode+ | EnterSecureMode+ | EnterProtectedMode+ | EnterReverseMode+ | EnterStandoutMode+ | EnterUnderlineMode+ | EraseChars+ | ExitAltCharsetMode+ | ExitAttributeMode+ | ExitCaMode+ | ExitDeleteMode+ | ExitInsertMode+ | ExitStandoutMode+ | ExitUnderlineMode+ | FlashScreen+ | FormFeed+ | FromStatusLine+ | Init1string+ | Init2string+ | Init3string+ | InitFile+ | InsertCharacter+ | InsertLine+ | InsertPadding+ | KeyBackspace+ | KeyCatab+ | KeyClear+ | KeyCtab+ | KeyDc+ | KeyDl+ | KeyDown+ | KeyEic+ | KeyEol+ | KeyEos+ | KeyF0+ | KeyF1+ | KeyF10+ | KeyF2+ | KeyF3+ | KeyF4+ | KeyF5+ | KeyF6+ | KeyF7+ | KeyF8+ | KeyF9+ | KeyHome+ | KeyIc+ | KeyIl+ | KeyLeft+ | KeyLl+ | KeyNpage+ | KeyPpage+ | KeyRight+ | KeySf+ | KeySr+ | KeyStab+ | KeyUp+ | KeypadLocal+ | KeypadXmit+ | LabF0+ | LabF1+ | LabF10+ | LabF2+ | LabF3+ | LabF4+ | LabF5+ | LabF6+ | LabF7+ | LabF8+ | LabF9+ | MetaOff+ | MetaOn+ | Newline+ | PadChar+ | ParmDch+ | ParmDeleteLine+ | ParmDownCursor+ | ParmIch+ | ParmIndex+ | ParmInsertLine+ | ParmLeftCursor+ | ParmRightCursor+ | ParmRindex+ | ParmUpCursor+ | PkeyKey+ | PkeyLocal+ | PkeyXmit+ | PrintScreen+ | PrtrOff+ | PrtrOn+ | RepeatChar+ | Reset1string+ | Reset2string+ | Reset3string+ | ResetFile+ | RestoreCursor+ | RowAddress+ | SaveCursor+ | ScrollForward+ | ScrollReverse+ | SetAttributes+ | SetTab+ | SetWindow+ | Tab+ | ToStatusLine+ | UnderlineChar+ | UpHalfLine+ | InitProg+ | KeyA1+ | KeyA3+ | KeyB2+ | KeyC1+ | KeyC3+ | PrtrNon+ | CharPadding+ | AcsChars+ | PlabNorm+ | KeyBtab+ | EnterXonMode+ | ExitXonMode+ | EnterAmMode+ | ExitAmMode+ | XonCharacter+ | XoffCharacter+ | EnaAcs+ | LabelOn+ | LabelOff+ | KeyBeg+ | KeyCancel+ | KeyClose+ | KeyCommand+ | KeyCopy+ | KeyCreate+ | KeyEnd+ | KeyEnter+ | KeyExit+ | KeyFind+ | KeyHelp+ | KeyMark+ | KeyMessage+ | KeyMove+ | KeyNext+ | KeyOpen+ | KeyOptions+ | KeyPrevious+ | KeyPrint+ | KeyRedo+ | KeyReference+ | KeyRefresh+ | KeyReplace+ | KeyRestart+ | KeyResume+ | KeySave+ | KeySuspend+ | KeyUndo+ | KeySbeg+ | KeyScancel+ | KeyScommand+ | KeyScopy+ | KeyScreate+ | KeySdc+ | KeySdl+ | KeySelect+ | KeySend+ | KeySeol+ | KeySexit+ | KeySfind+ | KeyShelp+ | KeyShome+ | KeySic+ | KeySleft+ | KeySmessage+ | KeySmove+ | KeySnext+ | KeySoptions+ | KeySprevious+ | KeySprint+ | KeySredo+ | KeySreplace+ | KeySright+ | KeySrsume+ | KeySsave+ | KeySsuspend+ | KeySundo+ | ReqForInput+ | KeyF11+ | KeyF12+ | KeyF13+ | KeyF14+ | KeyF15+ | KeyF16+ | KeyF17+ | KeyF18+ | KeyF19+ | KeyF20+ | KeyF21+ | KeyF22+ | KeyF23+ | KeyF24+ | KeyF25+ | KeyF26+ | KeyF27+ | KeyF28+ | KeyF29+ | KeyF30+ | KeyF31+ | KeyF32+ | KeyF33+ | KeyF34+ | KeyF35+ | KeyF36+ | KeyF37+ | KeyF38+ | KeyF39+ | KeyF40+ | KeyF41+ | KeyF42+ | KeyF43+ | KeyF44+ | KeyF45+ | KeyF46+ | KeyF47+ | KeyF48+ | KeyF49+ | KeyF50+ | KeyF51+ | KeyF52+ | KeyF53+ | KeyF54+ | KeyF55+ | KeyF56+ | KeyF57+ | KeyF58+ | KeyF59+ | KeyF60+ | KeyF61+ | KeyF62+ | KeyF63+ | ClrBol+ | ClearMargins+ | SetLeftMargin+ | SetRightMargin+ | LabelFormat+ | SetClock+ | DisplayClock+ | RemoveClock+ | CreateWindow+ | GotoWindow+ | Hangup+ | DialPhone+ | QuickDial+ | Tone+ | Pulse+ | FlashHook+ | FixedPause+ | WaitTone+ | User0+ | User1+ | User2+ | User3+ | User4+ | User5+ | User6+ | User7+ | User8+ | User9+ | OrigPair+ | OrigColors+ | InitializeColor+ | InitializePair+ | SetColorPair+ | SetForeground+ | SetBackground+ | ChangeCharPitch+ | ChangeLinePitch+ | ChangeResHorz+ | ChangeResVert+ | DefineChar+ | EnterDoublewideMode+ | EnterDraftQuality+ | EnterItalicsMode+ | EnterLeftwardMode+ | EnterMicroMode+ | EnterNearLetterQuality+ | EnterNormalQuality+ | EnterShadowMode+ | EnterSubscriptMode+ | EnterSuperscriptMode+ | EnterUpwardMode+ | ExitDoublewideMode+ | ExitItalicsMode+ | ExitLeftwardMode+ | ExitMicroMode+ | ExitShadowMode+ | ExitSubscriptMode+ | ExitSuperscriptMode+ | ExitUpwardMode+ | MicroColumnAddress+ | MicroDown+ | MicroLeft+ | MicroRight+ | MicroRowAddress+ | MicroUp+ | OrderOfPins+ | ParmDownMicro+ | ParmLeftMicro+ | ParmRightMicro+ | ParmUpMicro+ | SelectCharSet+ | SetBottomMargin+ | SetBottomMarginParm+ | SetLeftMarginParm+ | SetRightMarginParm+ | SetTopMargin+ | SetTopMarginParm+ | StartBitImage+ | StartCharSetDef+ | StopBitImage+ | StopCharSetDef+ | SubscriptCharacters+ | SuperscriptCharacters+ | TheseCauseCr+ | ZeroMotion+ | CharSetNames+ | KeyMouse+ | MouseInfo+ | ReqMousePos+ | GetMouse+ | SetAForeground+ | SetABackground+ | PkeyPlab+ | DeviceType+ | CodeSetInit+ | Set0DesSeq+ | Set1DesSeq+ | Set2DesSeq+ | Set3DesSeq+ | SetLrMargin+ | SetTbMargin+ | BitImageRepeat+ | BitImageNewline+ | BitImageCarriageReturn+ | ColorNames+ | DefineBitImageRegion+ | EndBitImageRegion+ | SetColorBand+ | SetPageLength+ | DisplayPcChar+ | EnterPcCharsetMode+ | ExitPcCharsetMode+ | EnterScancodeMode+ | ExitScancodeMode+ | PcTermOptions+ | ScancodeEscape+ | AltScancodeEsc+ | EnterHorizontalHlMode+ | EnterLeftHlMode+ | EnterLowHlMode+ | EnterRightHlMode+ | EnterTopHlMode+ | EnterVerticalHlMode+ | SetAAttributes+ | SetPglenInch+ | TermcapInit2+ | TermcapReset+ | LinefeedIfNotLf+ | BackspaceIfNotBs+ | OtherNonFunctionKeys+ | ArrowKeyMap+ | AcsUlcorner+ | AcsLlcorner+ | AcsUrcorner+ | AcsLrcorner+ | AcsLtee+ | AcsRtee+ | AcsBtee+ | AcsTtee+ | AcsHline+ | AcsVline+ | AcsPlus+ | MemoryLock+ | MemoryUnlock+ | BoxChars1+ deriving (Ord, Eq, Enum, Bounded, Show)
+ src/System/Terminfo/DBParse.hs view
@@ -0,0 +1,129 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE CPP #-}++-- |+-- Module : System.Terminfo.DBParse+-- Copyright : (c) Bryan Richter (2013)+-- License : BSD-style+-- +-- Maintainer : bryan.richter@gmail.com+--+-- An internal module encapsulating methods for parsing a terminfo file as+-- generated by tic(1). The primary reference is the term(5) manpage.+--++module System.Terminfo.DBParse+ ( parseDB+ ) where++#if ! MIN_VERSION_base(4,8,0)+import Control.Applicative ((<$>), (<*>))+#endif+import Control.Arrow ((***))+import qualified Control.Arrow as Arr+import Control.Monad ((<=<), when, void)+import Data.Attoparsec.ByteString as A+import Data.ByteString (ByteString)+import qualified Data.ByteString as B+import Data.Char (chr)+import qualified Data.Map.Lazy as M+import Data.Word (Word16)++import System.Terminfo.Types++-- | term(5) defines a short integer as two 8-bit bytes, so:+type ShortInt = Word16++-- | short ints are stored little-endian.+shortInt :: Integral a => ShortInt -> Parser a+shortInt i = word8 first >> word8 second >> return (fromIntegral i)+ where+ (second, first) = (fromIntegral *** fromIntegral) $ i `divMod` 256++-- | short ints are stored little-endian.+--+-- (-1) is represented by the two bytes 0o377 0o377.+--+-- Return type is Int so I can include (-1) in the possible outputs. I+-- wonder if I will regret this.+anyShortInt :: Parser Int+anyShortInt = do+ first <- fromIntegral <$> anyWord8+ second <- fromIntegral <$> anyWord8+ return $ if first == 0o377 && second == 0o377+ then (-1)+ else 256*second + first++parseDB :: ByteString -> Either String TIDatabase+parseDB = parseOnly tiDatabase++tiDatabase :: Parser TIDatabase+tiDatabase = do+ Header{..} <- header+ -- Ignore names+ _ <- A.take namesSize+ bools <- boolCaps boolSize+ -- Align on an even byte+ when (odd boolSize) (void $ A.take 1)+ nums <- numCaps numIntegers+ strs <- stringCaps numOffsets stringSize+ -- TODO: extended info+ return $ TIDatabase bools nums strs++boolCaps :: Int -- ^ Number of caps+ -> Parser TCBMap+boolCaps =+ return . TCBMap . M.fromList . zip keys . map (== 1) . B.unpack+ <=< A.take+ where+ {-keys :: [BoolTermCap]-}+ keys = [minBound ..]++-- Negative values indicate missing capability.+numCaps :: Int -- ^ Number of caps+ -> Parser TCNMap+numCaps = return . TCNMap . M.fromList . filter notNeg . zip keys+ <=< flip A.count anyShortInt+ where+ notNeg = ((/= -1) . snd)+ {-keys :: [BoolTermCap]-}+ keys = [minBound ..]++stringCaps :: Int -- ^ Number of caps+ -> Int -- ^ Size of table+ -> Parser TCSMap+stringCaps numOffsets stringSize = do+ offs <- A.count numOffsets anyShortInt+ stringTable <- A.take stringSize+ return+ $ TCSMap $ M.fromList $ map (parseValue stringTable)+ $ filter notNeg $ zip keys offs+ where+ notNeg = ((/= -1) . snd)+ keys = [minBound ..]+ parseValue tbl = Arr.second $ parseString tbl+ parseString table offset =+ asString+ $ B.takeWhile (/= 0) -- null-terminated+ $ B.drop offset table -- starts at offset+ asString = map (chr . fromIntegral) . B.unpack++-- | the magic number for term files+magic :: Parser Int+magic = shortInt 0o432 <?> "Not a terminfo file (bad magic)"++data Header = Header+ { namesSize :: !Int+ , boolSize :: !Int+ , numIntegers :: !Int+ , numOffsets :: !Int+ , stringSize :: !Int+ }+ deriving (Show)++header :: Parser Header+header = magic >> Header <$> anyShortInt+ <*> anyShortInt+ <*> anyShortInt+ <*> anyShortInt+ <*> anyShortInt
+ src/System/Terminfo/Internal.hs view
@@ -0,0 +1,70 @@+{-# LANGUAGE CPP #-}+module System.Terminfo.Internal+ ( terminfoDBLocs+ , locationsPure+ , parseTDVar+ ) where++#if ! MIN_VERSION_base(4,8,0)+import Control.Applicative ((<$>), (<*>), pure)+#endif+import Control.Error+import System.Environment (lookupEnv)+import System.FilePath++terminfoDBLocs :: IO [FilePath]+terminfoDBLocs = locationsPure+ <$> lookupEnv "TERMINFO"+ <*> (lookupEnv "HOME" <$$/> ".terminfo")+ <*> lookupEnv "TERMINFO_DIRS"+ <*> pure ["/lib/terminfo", "/usr/share/terminfo"]+++(<$/>) :: Functor f => f FilePath -> FilePath -> f FilePath+fa <$/> b = (</> b) <$> fa+infixr 4 <$/>++(<$$/>) :: (Functor f, Functor g)+ => f (g FilePath)+ -> FilePath+ -> f (g FilePath)+ffa <$$/> b = fmap (<$/> b) ffa+infixr 4 <$$/>++-- | I hate this name. There is undoubtedly a better way of structuring all+-- of this, starting way up at 'dirTreeDB'.+locationsPure :: Maybe FilePath -- ^ Override directory+ -> Maybe FilePath -- ^ $HOME+ -> Maybe String -- ^ $TERMINFO_DIRS+ -> [FilePath] -- ^ Defaults+ -> [FilePath]+locationsPure ovr usr termdirs defs = case ovr of+ Just override -> [override]+ Nothing -> catMaybes [usr] ++ system++ where+ system = case termdirs of+ Just list -> parseTDVar defs list+ Nothing -> defs++parseTDVar :: [String] -> String -> [String]+parseTDVar defs = replace "" defs . split ':'++-- | Replace an element with multiple replacements+replace :: Eq a => a -> [a] -> [a] -> [a]+replace old news = foldr (\x acc -> if x == old+ then news ++ acc+ else x : acc)+ []++-- | split, as seen in ByteString and Text, but for Strings.+split :: Char -> String -> [String]+split s = foldr go [[]]+ where+ go c acc = if c /= s+ then unshift c acc+ else "" : acc++ -- | /perldoc -f unshift/+ unshift c (xs:xss) = (c:xs) : xss+ unshift c [] = [[c]]
+ src/System/Terminfo/Types.hs view
@@ -0,0 +1,20 @@+module System.Terminfo.Types+ ( TIDatabase(..)+ , TCBMap(..)+ , TCNMap(..)+ , TCSMap(..)+ ) where++import Data.Map.Lazy (Map)++import System.Terminfo.Caps++data TCBMap = TCBMap (Map BoolTermCap Bool)+ deriving (Show)+data TCNMap = TCNMap (Map NumTermCap Int)+ deriving (Show)+data TCSMap = TCSMap (Map StrTermCap String)+ deriving (Show)++data TIDatabase = TIDatabase TCBMap TCNMap TCSMap+ deriving (Show)
terminfo-hs.cabal view
@@ -1,20 +1,19 @@-name: terminfo-hs-version: 0.1.0.1-synopsis: A pure-Haskell (no FFI) module for accessing terminfo databases-description: This module can acquire terminfo databases and query- them for terminal capabilities. For details of- terminfo, consult the man pages for term(5) and- terminfo(5).+name: terminfo-hs+version: 0.2.0+synopsis: A pure-Haskell (no FFI) module for accessing terminfo databases+description:+ This module can acquire terminfo databases and query them for terminal+ capabilities. For details of terminfo, consult the man pages for+ term(5) and terminfo(5). - This package is dead simple, and doesn't do anything- fancy with the capabilities themselves. It merely- provides a means for accessing them.+ This package is dead simple, and doesn't do anything fancy with the+ capabilities themselves. It merely provides a means for accessing them. license: BSD3 license-file: LICENSE author: Bryan Richter maintainer: bryan.richter@gmail.com-copyright: Bryan Richter, 2013+copyright: Bryan Richter, 2013–2015 category: System, Terminal build-type: Simple cabal-version: >=1.8@@ -25,22 +24,31 @@ source-repository this type: git- tag: 0.1.0.1- location: https://github.com/chreekat/terminfo-hs/tree/0.1.0.0+ tag: 0.2.0+ location: https://github.com/chreekat/terminfo-hs.git library- ghc-options: -Wall- exposed-modules: System.Terminfo, System.Terminfo.Caps- other-modules: System.Terminfo.DBParse,- System.Terminfo.Types- System.Terminfo.Internal- build-depends: base ==4.*, errors ==1.*,- bytestring ==0.*, directory ==1.*,- filepath ==1.*, attoparsec ==0.*,- containers ==0.5.*+ hs-source-dirs: src+ exposed-modules: System.Terminfo,+ System.Terminfo.Caps+ System.Terminfo.Internal+ other-modules: System.Terminfo.DBParse,+ System.Terminfo.Types+ build-depends: base <= 4.8,+ errors,+ bytestring,+ directory,+ filepath,+ attoparsec,+ containers -test-suite System.Terminfo.Internal- type: exitcode-stdio-1.0- main-is: test.hs- build-depends: base ==4.*, filepath ==1.*, directory ==1.*,- errors ==1.*, QuickCheck+test-suite test+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: test.hs+ build-depends: base,+ filepath,+ directory,+ errors,+ QuickCheck,+ terminfo-hs
− test.hs
@@ -1,42 +0,0 @@-{-# LANGUAGE TemplateHaskell #-}--import Test.QuickCheck-import Test.QuickCheck.All-import System.Terminfo.Internal--import Data.Maybe--prop_useOverride ovr =- forAll notLikely $ \usr ->- forAll notLikely $ \tds ->- forAll oftenNull $ \defs ->- classify (isNothing usr && isNothing tds && null defs)- "Nothing else specified"$- classify (isJust usr && isJust tds && not (null defs))- "Everything else specified"$- locationsPure (Just ovr) usr tds defs == [ovr]--notLikely = frequency [(2, return Nothing), (1, fmap Just arbitrary)]-oftenNull = frequency [(2, return []), (1, arbitrary)]--prop_includeHome usr =- forAll notLikely $ \tds ->- forAll oftenNull $ \defs ->- let- withUsr = locationsPure Nothing (Just usr) tds defs- withoutUsr = locationsPure Nothing Nothing tds defs- in- classify (isJust tds || not (null defs))- "Something besides HOME specified"$- withUsr == usr : withoutUsr--prop_terminfoDirsOverridesDefaults tds =- forAll (oneof [return [], listOf1 arbitrary]) $ \defs ->- classify (not $ null defs) "Defaults specified"$- locationsPure Nothing Nothing (Just tds) defs- == parseTDVar defs tds--prop_useDefaults defs =- locationsPure Nothing Nothing Nothing defs == defs--main = $quickCheckAll
+ test/test.hs view
@@ -0,0 +1,44 @@+{-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}++import Test.QuickCheck+import System.Terminfo.Internal++import Data.Maybe++prop_useOverride ovr =+ forAll notLikely $ \usr ->+ forAll notLikely $ \tds ->+ forAll oftenNull $ \defs ->+ classify (isNothing usr && isNothing tds && null defs)+ "Nothing else specified"$+ classify (isJust usr && isJust tds && not (null defs))+ "Everything else specified"$+ locationsPure (Just ovr) usr tds defs == [ovr]++notLikely = frequency [(2, return Nothing), (1, fmap Just arbitrary)]+oftenNull = frequency [(2, return []), (1, arbitrary)]++prop_includeHome usr =+ forAll notLikely $ \tds ->+ forAll oftenNull $ \defs ->+ let+ withUsr = locationsPure Nothing (Just usr) tds defs+ withoutUsr = locationsPure Nothing Nothing tds defs+ in+ classify (isJust tds || not (null defs))+ "Something besides HOME specified"$+ withUsr == usr : withoutUsr++prop_terminfoDirsOverridesDefaults tds =+ forAll (oneof [return [], listOf1 arbitrary]) $ \defs ->+ classify (not $ null defs) "Defaults specified"$+ locationsPure Nothing Nothing (Just tds) defs+ == parseTDVar defs tds++prop_useDefaults defs =+ locationsPure Nothing Nothing Nothing defs == defs++return []++main = $quickCheckAll