text:
{-# LANGUAGE StandaloneDeriving #-}
--  C->Haskell Compiler: CHS file abstraction
--
--  Author : Manuel M T Chakravarty
--  Created: 16 August 99
--
--  Copyright (c) [1999..2005] Manuel M T Chakravarty
--
--  This file is free software; you can redistribute it and/or modify
--  it under the terms of the GNU General Public License as published by
--  the Free Software Foundation; either version 2 of the License, or
--  (at your option) any later version.
--
--  This file is distributed in the hope that it will be useful,
--  but WITHOUT ANY WARRANTY; without even the implied warranty of
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
--  GNU General Public License for more details.
--
--- DESCRIPTION ---------------------------------------------------------------
--
--  Main file for reading CHS files.
--
--  Import hooks & .chi files
--  -------------------------
--
--  Reading of `.chi' files is interleaved with parsing.  More precisely,
--  whenever the parser comes across an import hook, it immediately reads the
--  `.chi' file and inserts its contents into the abstract representation of
--  the hook.  The parser checks the version of the `.chi' file, but does not
--  otherwise attempt to interpret its contents.  This is only done during
--  generation of the binding module.  The first line of a .chi file has the
--  form
--
--    C->Haskell Interface Version <version>
--
--  where <version> is the three component version number `Version.version'.
--  C->Haskell will only accept files whose version number match its own in
--  the first two components (ie, major and minor version).  In other words,
--  it must be guaranteed that the format of .chi files is not altered between
--  versions that differ only in their patchlevel.  All remaining lines of the
--  file are version dependent and contain a dump of state information that
--  the binding file generator needs to rescue across modules.
--
--- DOCU ----------------------------------------------------------------------
--
--  language: Haskell 98
--
--  The following binding hooks are recognised:
--
--  hook     -> `{#' inner `#}'
--  inner    -> `import' ['qualified'] ident
--            | `context' ctxt
--            | `type' ident
--            | `sizeof' ident
--            | `alignof' ident
--            | `enum' idalias trans [`nocode'] [`with' prefix] [`add' prefix] [deriving]
--            | `enum` `define` idalias [deriving]
--            | `call' [`pure'] [`unsafe'] idalias
--            | `fun' [`pure'] [`unsafe'] idalias parms
--            | `get' [`struct'] apath
--            | `set' [`struct'] apath
--            | `offsetof` apath
--            | `pointer' ['*'] idalias ptrkind ['nocode']
--            | `class' [ident `=>'] ident ident
--            | `const' ident
--            | `default' ident ident [dft ...]
--  ctxt     -> [`lib' `=' string] [prefix]
--  idalias  -> ident
--            | looseident [`as' (ident | `^' | `'' ident1 ident2 ... `'')]
--  prefix   -> `prefix' `=' string [`add' `prefix' `=' string]
--  deriving -> `deriving' `(' ident_1 `,' ... `,' ident_n `)'
--  parms    -> [verbhs `=>'] `{' parm_1 `,' ... `,' parm_n `}' `->' parm
--  parm     -> `+'
--            | [ident_or_quot_1 [`*' | `-']] verbhs [`&'] [ident_or_quot_2 [`*'] [`-']]
--  ident_or_quot -> ident | quoths
--  apath    -> ident
--            | `*' apath
--            | apath `.' ident
--            | apath `->' ident
--  trans    -> `{' alias_1 `,' ... `,' alias_n `}' [omit]
--  omit     -> `omit' `(' ident_1 `,' ... `,' ident_n `)'
--  alias    -> `underscoreToCase' | `upcaseFirstLetter'
--            | `downcaseFirstLetter'
--            | ident `as' ident
--  ptrkind  -> [`foreign' [`finalizer' idalias] | `stable'] ['newtype' | '->' ident]
--  dft      -> dfttype `=` ident [`*']
--  dfttype  -> `in' | `out' | `ptr_in' | `ptr_out'
--
--  If `underscoreToCase', `upcaseFirstLetter', or `downcaseFirstLetter'
--  occurs in a translation table, it must be the first entry, or if two of
--  them occur the first two entries.
--
--  Remark: Optional Haskell names are normalised during structure tree
--          construction, ie, associations that associated a name with itself
--          are removed.  (They don't carry semantic content, and make some
--          tests more complicated.)
--
--- TODO ----------------------------------------------------------------------
--

module C2HS.CHS (CHSModule(..), CHSFrag(..), CHSHook(..), CHSTrans(..),
            CHSChangeCase(..), CHSParm(..), CHSMarsh, CHSArg(..), CHSAccess(..),
            CHSAPath(..), CHSPtrType(..), CHSTypedefInfo, CHSDefaultMarsh,
            Direction(..),
            loadCHS, dumpCHS, hssuffix, chssuffix, loadCHI, dumpCHI, chisuffix,
            showCHSParm, apathToIdent, apathRootIdent, hasNonGNU,
            isParmWrapped)
where

-- standard libraries
import Data.Char (isSpace, toUpper, toLower)
import Data.List (intersperse)
import Control.Monad (when)
import System.FilePath ((<.>), (</>))

-- Language.C
import Language.C.Data.Ident
import Language.C.Data.Position
import Data.Errors       (interr)

-- C->Haskell
import C2HS.State (CST, getSwitch, chiPathSB, catchExc, throwExc, raiseError,
                  fatal, errorsPresent, showErrors, Traces(..), putTraceStr)
import qualified System.CIO as CIO
import C2HS.C.Info (CPrimType(..))
import C2HS.Version    (version)

-- friends
import C2HS.CHS.Lexer  (CHSToken(..), lexCHS, keywordToIdent)

-- CHS abstract syntax
-- -------------------

-- | representation of a CHS module
--
data CHSModule = CHSModule [CHSFrag]

deriving instance Show CHSModule
deriving instance Show CHSFrag
deriving instance Show CHSHook
deriving instance Show CHSAccess
deriving instance Show CHSParm
deriving instance Show CHSTrans
deriving instance Show CHSArg
deriving instance Show CHSChangeCase

-- | a CHS code fragament
--
-- * 'CHSVerb' fragments are present throughout the compilation and finally
--   they are the only type of fragment (describing the generated Haskell
--   code)
--
-- * 'CHSHook' are binding hooks, which are being replaced by Haskell code by
--   'GenBind.expandHooks'
--
-- * 'CHSCPP' and 'CHSC' are fragements of C code that are being removed when
--   generating the custom C header in 'GenHeader.genHeader'
--
-- * 'CHSCond' are strutured conditionals that are being generated by
--   'GenHeader.genHeader' from conditional CPP directives ('CHSCPP')
--
data CHSFrag = CHSVerb String                   -- Haskell code
                       Position
             | CHSHook CHSHook                  -- binding hook
                       Position
             | CHSCPP  String                   -- pre-processor directive
                       Position
                       Bool
             | CHSLine Position                 -- line pragma
             | CHSC    String                   -- C code
                       Position
             | CHSCond [(Ident,                 -- C variable repr. condition
                         [CHSFrag])]            -- then/elif branches
                       (Maybe [CHSFrag])        -- else branch

hasNonGNU :: CHSModule -> Bool
hasNonGNU (CHSModule frags) = any isNonGNU frags
  where isNonGNU (CHSHook (CHSNonGNU _) _) = True
        isNonGNU _                         = False

instance Pos CHSFrag where
  posOf (CHSVerb _ pos  ) = pos
  posOf (CHSHook _ pos  ) = pos
  posOf (CHSCPP  _ pos _) = pos
  posOf (CHSLine   pos  ) = pos
  posOf (CHSC    _ pos  ) = pos
  posOf (CHSCond alts _ ) = case alts of
                             (_, frag:_):_ -> posOf frag
                             _             -> nopos

-- | a CHS binding hook
--
data CHSHook = CHSImport  Bool                  -- qualified?
                          Ident                 -- module name
                          String                -- content of .chi file
                          Position
             | CHSContext (Maybe String)        -- library name
                          (Maybe String)        -- prefix
                          (Maybe String)        -- replacement prefix
                          Position
             | CHSNonGNU  Position
             | CHSType    Ident                 -- C type
                          Position
             | CHSSizeof  Ident                 -- C type
                          Position
             | CHSAlignof Ident                 -- C type
                          Position
             | CHSEnum    Ident                 -- C enumeration type
                          (Maybe Ident)         -- Haskell name
                          CHSTrans              -- translation table
                          Bool                  -- emit code or not?
                          (Maybe String)        -- local prefix
                          (Maybe String)        -- local replacement prefix
                          [Ident]               -- instance requests from user
                          Position
             | CHSEnumDefine Ident              -- Haskell name
                          CHSTrans              -- translation table
                          [Ident]               -- instance requests from user
                          Position
             | CHSCall    Bool                  -- is a pure function?
                          Bool                  -- is unsafe?
                          CHSAPath              -- C function
                          (Maybe Ident)         -- Haskell name
                          Position
             | CHSFun     Bool                  -- is a pure function?
                          Bool                  -- is unsafe?
                          Bool                  -- is variadic?
                          [String]              -- variadic C parameter types
                          CHSAPath              -- C function
                          (Maybe Ident)         -- Haskell name
                          (Maybe String)        -- type context
                          [CHSParm]             -- argument marshalling
                          CHSParm               -- result marshalling
                          Position
             | CHSField   CHSAccess             -- access type
                          CHSAPath              -- access path
                          Position
             | CHSOffsetof CHSAPath             -- access path
                           Position
             | CHSPointer Bool                  -- explicit '*' in hook
                          Ident                 -- C pointer name
                          (Maybe Ident)         -- Haskell name
                          CHSPtrType            -- Ptr, ForeignPtr or StablePtr
                          Bool                  -- create new type?
                          [Ident]               -- Haskell type pointed to
                          Bool                  -- emit type decl?
                          Position
             | CHSClass   (Maybe Ident)         -- superclass
                          Ident                 -- class name
                          Ident                 -- name of pointer type
                          Position
             | CHSConst   Ident                 -- C identifier
                          Position
             | CHSTypedef Ident                 -- C type name
                          Ident                 -- Haskell type name
                          Position
             | CHSDefault Direction             -- in or out marshaller?
                          String                -- Haskell type name
                          String                -- C type string
                          Bool                  -- is it a C pointer?
                          (Either Ident String, CHSArg) -- marshaller
                          Position

data Direction = In | Out deriving (Eq, Ord, Show)

instance Pos CHSHook where
  posOf (CHSImport  _ _ _             pos) = pos
  posOf (CHSContext _ _ _             pos) = pos
  posOf (CHSType    _                 pos) = pos
  posOf (CHSSizeof  _                 pos) = pos
  posOf (CHSAlignof _                 pos) = pos
  posOf (CHSEnum    _ _ _ _ _ _ _     pos) = pos
  posOf (CHSEnumDefine _ _ _          pos) = pos
  posOf (CHSCall    _ _ _ _           pos) = pos
  posOf (CHSFun     _ _ _ _ _ _ _ _ _ pos) = pos
  posOf (CHSField   _ _               pos) = pos
  posOf (CHSOffsetof _                pos) = pos
  posOf (CHSPointer _ _ _ _ _ _ _     pos) = pos
  posOf (CHSClass   _ _ _             pos) = pos
  posOf (CHSConst   _                 pos) = pos
  posOf (CHSTypedef _ _               pos) = pos
  posOf (CHSDefault _ _ _ _ _         pos) = pos

-- | two hooks are equal if they have the same Haskell name and reference the
-- same C object
--
instance Eq CHSHook where
  (CHSImport qual1 ide1 _           _) == (CHSImport qual2 ide2 _           _) =
    qual1 == qual2 && ide1 == ide2
  (CHSContext olib1 opref1 orpref1  _) == (CHSContext olib2 opref2 orpref2  _) =
    olib1 == olib2 && opref1 == opref2 && orpref1 == orpref2
  (CHSType ide1                     _) == (CHSType ide2                     _) =
    ide1 == ide2
  (CHSSizeof ide1                   _) == (CHSSizeof ide2                   _) =
    ide1 == ide2
  (CHSAlignof ide1                  _) == (CHSAlignof ide2                  _) =
    ide1 == ide2
  (CHSEnum ide1 oalias1 _ _ _ _ _   _) == (CHSEnum ide2 oalias2 _ _ _ _ _   _) =
    oalias1 == oalias2 && ide1 == ide2
  (CHSEnumDefine ide1 _ _           _) == (CHSEnumDefine ide2 _ _           _) =
    ide1 == ide2
  (CHSCall _ _ ide1 oalias1         _) == (CHSCall _ _ ide2 oalias2         _) =
    oalias1 == oalias2 && ide1 == ide2
  (CHSFun _ _ _ _ ide1 oalias1 _ _ _ _) ==
    (CHSFun _ _ _ _ ide2 oalias2 _ _ _ _) = oalias1 == oalias2 && ide1 == ide2
  (CHSField acc1 path1              _) == (CHSField acc2 path2              _) =
    acc1 == acc2 && path1 == path2
  (CHSOffsetof path1                _) == (CHSOffsetof path2                _) =
    path1 == path2
  (CHSPointer _ ide1 oalias1 _ _ _ _ _)
                                      == (CHSPointer _ ide2 oalias2 _ _ _ _ _) =
    ide1 == ide2 && oalias1 == oalias2
  (CHSClass _ ide1 _                _) == (CHSClass _ ide2 _                _) =
    ide1 == ide2
  (CHSConst ide1                    _) == (CHSConst ide2                    _) =
    ide1 == ide2
  (CHSTypedef ide1 _                _) == (CHSTypedef ide2 _                _) =
    ide1 == ide2
  (CHSDefault _ ide1 _ _ _          _) == (CHSDefault _ ide2 _ _ _          _) =
    ide1 == ide2
  _                               == _                          = False

-- | translation table
--
data CHSTrans = CHSTrans Bool                   -- underscore to case?
                         CHSChangeCase          -- upcase or downcase?
                         [(Ident, Ident)]       -- alias list
                         [Ident]                -- omit list

data CHSChangeCase = CHSSameCase
                   | CHSUpCase
                   | CHSDownCase
                   deriving Eq

-- | marshaller consists of a function name or verbatim Haskell code
--   and flag indicating whether it has to be executed in the IO monad
--
type CHSMarsh = Maybe (Either Ident String, CHSArg)

-- | Type default information
type CHSTypedefInfo = (Ident, CPrimType)

-- | Type default information
type CHSDefaultMarsh = (Either Ident String, CHSArg)

-- | marshalling descriptor for function hooks
--
data CHSParm = CHSPlusParm       -- special "+" parameter
             | CHSParm CHSMarsh  -- "in" marshaller
                       String    -- Haskell type
                       Bool      -- C repr: two values?
                       CHSMarsh  -- "out" marshaller
                       Bool      -- wrapped?
                       Position
                       String    -- Comment for this para

-- | Check whether parameter requires wrapping for bare structures.
--
isParmWrapped :: CHSParm -> Bool
isParmWrapped (CHSParm _ _ _ _ w _ _) = w
isParmWrapped _ = False

-- | kinds of arguments in function hooks
--
data CHSArg = CHSValArg                         -- plain value argument
            | CHSIOArg                          -- reference argument
            | CHSVoidArg                        -- no argument
            | CHSIOVoidArg                      -- drops argument, but in monad
            deriving (Eq)

-- | structure member access types
--
data CHSAccess = CHSSet                         -- set structure field
               | CHSGet                         -- get structure field
               deriving (Eq)

-- | structure access path
--
data CHSAPath = CHSRoot Bool Ident
                -- root of access path with flag indicating presence
                -- of "struct" keyword
              | CHSDeref CHSAPath Position      -- dereferencing
              | CHSRef   CHSAPath Ident         -- member referencing
              deriving (Eq,Show)

instance Pos CHSAPath where
    posOf (CHSRoot _ ide)  = posOf ide
    posOf (CHSDeref _ pos) = pos
    posOf (CHSRef _ ide)   = posOf ide

-- | pointer options
--

data CHSPtrType = CHSPtr
                  -- standard Ptr from Haskell
                | CHSForeignPtr (Maybe (Ident, Maybe Ident))
                  -- a foreign pointer possibly with a finalizer
                | CHSStablePtr
                  -- a pointer into Haskell land
                deriving (Eq)

instance Show CHSPtrType where
  show CHSPtr            = "Ptr"
  show (CHSForeignPtr _) = "ForeignPtr"
  show CHSStablePtr      = "StablePtr"

instance Read CHSPtrType where
  readsPrec _ (                            'P':'t':'r':rest) =
    [(CHSPtr, rest)]
  readsPrec _ ('F':'o':'r':'e':'i':'g':'n':'P':'t':'r':rest) =
    [(CHSForeignPtr Nothing, rest)]
  readsPrec _ ('S':'t':'a':'b':'l':'e'    :'P':'t':'r':rest) =
    [(CHSStablePtr, rest)]
  readsPrec p (c:cs)
    | isSpace c                                              = readsPrec p cs
  readsPrec _ _                                              = []

-- load and dump a CHS file
-- ------------------------

hssuffix, chssuffix :: String
hssuffix  = "hs"
chssuffix = "chs"

-- | load a CHS module
--
-- * the file suffix is automagically appended
--
-- * in case of a syntactical or lexical error, a fatal error is raised;
--   warnings are returned together with the module
--
loadCHS       :: FilePath -> CST s (CHSModule, String)
loadCHS fname  = do
                   let fullname = fname <.> chssuffix

                   -- read file
                   --
                   traceInfoRead fullname
                   contents <- CIO.readFile fullname

                   -- parse
                   --
                   traceInfoParse
                   mod' <- parseCHSModule (initPos fullname) contents

                   -- check for errors and finalize
                   --
                   errs <- errorsPresent
                   if errs
                     then do
                       traceInfoErr
                       errmsgs <- showErrors
                       fatal ("CHS module contains \
                              \errors:\n\n" ++ errmsgs)   -- fatal error
                     else do
                       traceInfoOK
                       warnmsgs <- showErrors
                       return (mod', warnmsgs)
                  where
                    traceInfoRead fname' = putTraceStr tracePhasesSW
                                             ("Attempting to read file `"
                                              ++ fname' ++ "'...\n")
                    traceInfoParse       = putTraceStr tracePhasesSW
                                             ("...parsing `"
                                              ++ fname ++ "'...\n")
                    traceInfoErr         = putTraceStr tracePhasesSW
                                             ("...error(s) detected in `"
                                              ++ fname ++ "'.\n")
                    traceInfoOK          = putTraceStr tracePhasesSW
                                             ("...successfully loaded `"
                                              ++ fname ++ "'.\n")

-- | given a file name (no suffix) and a CHS module, the module is printed
-- into that file
--
-- * the module can be flagged as being pure Haskell
--
-- * the correct suffix will automagically be appended
--
dumpCHS                       :: String -> CHSModule -> Bool -> CST s ()
dumpCHS fname mod' pureHaskell  =
  do
    let (suffix, kind) = if pureHaskell
                         then (hssuffix , "(Haskell)")
                         else (chssuffix, "(C->HS binding)")
    CIO.writeFile (fname <.> suffix) (contents version kind)
  where
    contents version' kind =
      "-- GENERATED by " ++ version' ++ " " ++ kind ++ "\n\
      \-- Edit the ORIGNAL .chs file instead!\n\n"
      ++ showCHSModule mod' pureHaskell

-- | to keep track of the current state of the line emission automaton
--
data LineState = Emit           -- emit LINE pragma if next frag is Haskell
               | Wait           -- emit LINE pragma after the next '\n'
               | NoLine         -- no pragma needed
               deriving (Eq)

-- | convert a CHS module into a string
--
-- * if the second argument is 'True', all fragments must contain Haskell code
--
showCHSModule                               :: CHSModule -> Bool -> String
showCHSModule (CHSModule fragments) pureHaskell  =
  showFrags pureHaskell Emit fragments []
  where
    -- the second argument indicates whether the next fragment (if it is
    -- Haskell code) should be preceded by a LINE pragma; in particular
    -- generated fragments and those following them need to be prefixed with a
    -- LINE pragma
    --
    showFrags :: Bool -> LineState -> [CHSFrag] -> ShowS
    showFrags _      _     []                           = id
    showFrags pureHs state (CHSVerb s      pos : frags) =
      let
        (fname,line)     = (posFile pos, posRow pos)
        generated        = isBuiltinPos pos
        emitNow          = state == Emit ||
                           (state == Wait && not (null s) && head s == '\n')
        nextState        = if generated then Wait else NoLine
      in
        (if emitNow then
           showString ("\n{-# LINE " ++ show (line `max` 0) ++ " " ++
                       show fname ++ " #-}\n")
         else id)
      . showString s
      . showFrags pureHs nextState frags
    showFrags False  _     (CHSHook hook _     : frags) =
        showString "{#"
      . showCHSHook hook
      . showString "#}"
      . showFrags False Wait frags
    showFrags False  _     (CHSCPP  s    _ nl  : frags) =
      (if nl then showChar '\n' else id)
      . showChar '#'
      . showString s
      . showFrags False Emit frags
    showFrags pureHs _     (CHSLine _s         : frags) =
        showFrags pureHs Emit frags
    showFrags False  _     (CHSC    s    _     : frags) =
        showString "\n#c"
      . showString s
      . showString "\n#endc"
      . showFrags False Emit frags
    showFrags False  _     (CHSCond _    _     : _    ) =
      interr "showCHSFrag: Cannot print `CHSCond'!"
    showFrags True   _     _                            =
      interr "showCHSFrag: Illegal hook, cpp directive, or inline C code!"

showCHSHook :: CHSHook -> ShowS
showCHSHook (CHSImport isQual ide _ _) =
    showString "import "
  . (if isQual then showString "qualified " else id)
  . showCHSIdent ide
showCHSHook (CHSContext olib oprefix oreplprefix _) =
    showString "context "
  . (case olib of
       Nothing  -> showString ""
       Just lib -> showString "lib = " . showString lib . showString " ")
  . showPrefix oprefix False
  . showReplacementPrefix oreplprefix
showCHSHook (CHSType ide _) =
    showString "type "
  . showCHSIdent ide
showCHSHook (CHSSizeof ide _) =
    showString "sizeof "
  . showCHSIdent ide
showCHSHook (CHSAlignof   ide _) =
   showString "alignof "
  . showCHSIdent ide
showCHSHook (CHSEnum ide oalias trans emit oprefix oreplprefix derive _) =
    showString "enum "
  . showIdAlias ide oalias
  . showCHSTrans trans
  . (case emit of
        True  -> showString ""
        False -> showString " nocode")
  . showPrefix oprefix True
  . showReplacementPrefix oreplprefix
  . if null derive then id else showString $
      " deriving ("
      ++ concat (intersperse ", " (map identToString derive))
      ++ ") "
showCHSHook (CHSEnumDefine ide trans derive _) =
    showString "enum define "
  . showCHSIdent ide
  . showCHSTrans trans
  . if null derive then id else showString $
      " deriving ("
      ++ concat (intersperse ", " (map identToString derive))
      ++ ") "
showCHSHook (CHSCall isPure isUns ide oalias _) =
    showString "call "
  . (if isPure then showString "pure " else id)
  . (if isUns then showString "unsafe " else id)
  . showApAlias ide oalias
showCHSHook (CHSFun isPure isUns isVar varTypes ide oalias octxt parms parm _) =
    showString "fun "
  . (if isPure then showString "pure " else id)
  . (if isUns then showString "unsafe " else id)
  . (if isVar then showString "variadic " else id)
  . showFunAlias ide varTypes oalias
  . (case octxt of
       Nothing      -> showChar ' '
       Just ctxtStr -> showString ctxtStr . showString " => ")
  . showString "{"
  . foldr (.) id (intersperse (showString ", ") (map showCHSParm parms))
  . showString "} -> "
  . showCHSParm parm
showCHSHook (CHSField acc path _) =
    (case acc of
       CHSGet -> showString "get "
       CHSSet -> showString "set ")
  . showCHSAPath path
showCHSHook (CHSOffsetof path _) =
    showString "offsetof "
  . showCHSAPath path
showCHSHook (CHSPointer star ide oalias ptrType isNewtype oRefType emit _) =
    showString "pointer "
  . (if star then showString "*" else showString "")
  . showIdAlias ide oalias
  . (case ptrType of
       CHSForeignPtr Nothing    -> showString " foreign"
       CHSForeignPtr (Just (fide, foalias)) ->
         showString " foreign finalizer " . showIdAlias fide foalias
       CHSStablePtr             -> showString " stable"
       _                        -> showString "")
  . (case (isNewtype, oRefType) of
       (True , _        ) -> showString " newtype"
       (False, []       ) -> showString ""
       (False, ides) -> showString " -> " .
                        foldr (.) id (intersperse (showString " ")
                                      (map showCHSIdent ides)))
  . (case emit of
       True  -> showString ""
       False -> showString " nocode")
showCHSHook (CHSClass oclassIde classIde typeIde _) =
    showString "class "
  . (case oclassIde of
       Nothing        -> showString ""
       Just classIde' -> showCHSIdent classIde' . showString " => ")
  . showCHSIdent classIde
  . showString " "
  . showCHSIdent typeIde
showCHSHook (CHSConst constIde _) =
    showString "const "
  . showCHSIdent constIde
showCHSHook (CHSTypedef cIde hsIde _) =
    showString "typedef "
  . showCHSIdent cIde
  . showCHSIdent hsIde
showCHSHook (CHSDefault dir hsTy cTy cPtr marsh _) =
    showString "default "
    . showString (if dir == In then "in" else "out")
    . showChar '`' . showString hsTy . showChar '\''
    . showChar '[' . showString cTy
    . showString (if cPtr then " *" else "") . showChar ']'
    . showMarsh marsh
  where showMarsh (Left ide, arg) = showCHSIdent ide . showArg arg
        showMarsh (Right s, arg) = showString s . showArg arg
        showArg CHSIOArg = showString "*"
        showArg _ = showString ""

showPrefix                        :: Maybe String -> Bool -> ShowS
showPrefix Nothing       _         = showString ""
showPrefix (Just prefix) withWith  =   maybeWith
                                     . showString "prefix = "
                                     . showString prefix
                                     . showString " "
  where
    maybeWith = if withWith then showString "with " else id

showReplacementPrefix              :: Maybe String -> ShowS
showReplacementPrefix Nothing       = showString ""
showReplacementPrefix (Just prefix) = showString "add prefix = "
                                      . showString prefix
                                      . showString " "

showIdAlias            :: Ident -> Maybe Ident -> ShowS
showIdAlias ide oalias  =
    showCHSIdent ide
  . (case oalias of
       Nothing  -> id
       Just ide' -> showString " as " . showCHSIdent ide')

showApAlias            :: CHSAPath -> Maybe Ident -> ShowS
showApAlias apath oalias  =
    showCHSAPath apath
  . (case oalias of
       Nothing  -> id
       Just ide -> showString " as " . showCHSIdent ide)

showFunAlias            :: CHSAPath -> [String] -> Maybe Ident -> ShowS
showFunAlias apath vas oalias  =
    showCHSAPath apath
  . (if null vas
     then showString ""
     else showString "["
          . foldr (.) id (intersperse (showString ", ") (map showString vas))
          . showString "]")
  . (case oalias of
       Nothing  -> id
       Just ide -> showString " as " . showCHSIdent ide)

showCHSParm                                                :: CHSParm -> ShowS
showCHSParm CHSPlusParm = showChar '+'
showCHSParm (CHSParm oimMarsh hsTyStr twoCVals oomMarsh wrapped _ comment)  =
    showOMarsh oimMarsh
  . showChar ' '
  . (if wrapped then showChar '%' else id)
  . showHsVerb hsTyStr
  . (if twoCVals then showChar '&' else id)
  . showChar ' '
  . showOMarsh oomMarsh
  . showChar ' '
  . showComment comment
  where
    showOMarsh Nothing               = id
    showOMarsh (Just (body, argKind)) =   showMarshBody body
                                        . (case argKind of
                                             CHSValArg    -> id
                                             CHSIOArg     -> showString "*"
                                             CHSVoidArg   -> showString "-"
                                             CHSIOVoidArg -> showString "*-")
    --
    showMarshBody (Left ide) = showCHSIdent ide
    showMarshBody (Right str) = showChar '|' . showString str . showChar '|'
    --
    showHsVerb str = showChar '`' . showString str . showChar '\''
    showComment str = if null str
                      then showString ""
                      else showString "--" . showString str . showChar '\n'

showCHSTrans :: CHSTrans -> ShowS
showCHSTrans (CHSTrans _2Case chgCase assocs omit)  =
    showString " {"
  . (if _2Case then showString ("underscoreToCase" ++ maybeComma) else id)
  . showCHSChangeCase chgCase
  . foldr (.) id (intersperse (showString ", ") (map showAssoc assocs))
  . showString "}"
  . (if not (null omit)
     then showString " omit (" .
          foldr (.) id (intersperse (showString ", ") (map showCHSIdent omit)) .
          showString ")"
     else id)
  where
    maybeComma = if null assocs then "" else ", "
    --
    showAssoc (ide1, ide2) =
        showCHSIdent ide1
      . showString " as "
      . showCHSIdent ide2

showCHSChangeCase :: CHSChangeCase -> ShowS
showCHSChangeCase CHSSameCase = id
showCHSChangeCase CHSUpCase   = showString "upcaseFirstLetter"
showCHSChangeCase CHSDownCase = showString "downcaseFirstLetter"

showCHSAPath :: CHSAPath -> ShowS
showCHSAPath (CHSRoot True ide) =
    showString "struct "
  . showCHSIdent ide
showCHSAPath (CHSRoot False ide) =
  showCHSIdent ide
showCHSAPath (CHSDeref path _) =
    showString "* "
  . showCHSAPath path
showCHSAPath (CHSRef (CHSDeref path _) ide) =
    showCHSAPath path
  . showString "->"
  . showCHSIdent ide
showCHSAPath (CHSRef path ide) =
   showCHSAPath path
  . showString "."
  . showCHSIdent ide

showCHSIdent :: Ident -> ShowS
showCHSIdent ide = showString $ let s = identToString ide
                                in case ' ' `elem` s of
                                  False -> s
                                  True -> "'" ++ s ++ "'"

-- load and dump a CHI file
-- ------------------------

chisuffix :: String
chisuffix  = "chi"

versionPrefix :: String
versionPrefix  = "C->Haskell Interface Version "

-- | load a CHI file
--
-- * the file suffix is automagically appended
--
-- * any error raises a syntax exception (see below)
--
-- * the version of the .chi file is checked against the version of the current
--   executable; they must match in the major and minor version
--
loadCHI       :: FilePath -> CST s String
loadCHI fname  = do
                   -- search for .chi files
                   --
                   paths <- getSwitch chiPathSB
                   let fullnames = [path </> fname <.> chisuffix |
                                    path <- paths]
                   fullname <- findFirst fullnames
                     (fatal $ fname <.> chisuffix ++ " not found in:\n"++
                              unlines paths)
                   -- read file
                   --
                   traceInfoRead fullname
                   contents <- CIO.readFile fullname

                   -- parse
                   --
                   traceInfoVersion
                   let ls = lines contents
                   when (null ls) $
                     errorCHICorrupt fname
                   let versline:chi = ls
                       prefixLen    = length versionPrefix
                   when (length versline < prefixLen
                         || take prefixLen versline /= versionPrefix) $
                     errorCHICorrupt fname
                   let versline' = drop prefixLen versline
                   (major, minor) <- case majorMinor versline' of
                                       Nothing     -> errorCHICorrupt fname
                                       Just majMin -> return majMin

                   let Just (myMajor, myMinor) = majorMinor version
                   when (major /= myMajor || minor /= myMinor) $
                     errorCHIVersion fname
                       (major ++ "." ++ minor) (myMajor ++ "." ++ myMinor)

                   -- finalize
                   --
                   traceInfoOK
                   return $ concat chi
                  where
                    traceInfoRead fname' = putTraceStr tracePhasesSW
                                             ("Attempting to read file `"
                                              ++ fname' ++ "'...\n")
                    traceInfoVersion     = putTraceStr tracePhasesSW
                                             ("...checking version `"
                                              ++ fname ++ "'...\n")
                    traceInfoOK          = putTraceStr tracePhasesSW
                                             ("...successfully loaded `"
                                              ++ fname ++ "'.\n")
                    findFirst []        err =  err
                    findFirst (p:aths)  err =  do
                      e <- CIO.doesFileExist p
                      if e then return p else findFirst aths err

-- | given a file name (no suffix) and a CHI file, the information is printed
-- into that file
--
-- * the correct suffix will automagically be appended
--
dumpCHI                :: String -> String -> CST s ()
dumpCHI fname contents  =
  do
    CIO.writeFile (fname <.> chisuffix) $
      versionPrefix ++ version ++ "\n" ++ contents

-- | extract major and minor number from a version string
--
majorMinor      :: String -> Maybe (String, String)
majorMinor vers  = let (major, rest) = break (== '.') vers
                       (minor, _   ) = break (== '.') . tail $ rest
                   in
                   if null rest then Nothing else Just (major, minor)

-- parsing a CHS token stream
-- --------------------------

syntaxExc :: String
syntaxExc  = "syntax"

-- | alternative action in case of a syntax exception
--
ifError                :: CST s a -> CST s a -> CST s a
ifError action handler  = action `catchExc` (syntaxExc, const handler)

-- | raise syntax error exception
--
raiseSyntaxError :: CST s a
raiseSyntaxError  = throwExc syntaxExc "syntax error"

-- | parse a complete module
--
-- * errors are entered into the compiler state
--
parseCHSModule        :: Position -> String -> CST s CHSModule
parseCHSModule pos cs  = do
                           toks <- lexCHS cs pos
                           frags <- parseFrags toks
                           return $ CHSModule frags

-- | parsing of code fragments
--
-- * in case of an error, all tokens that are neither Haskell nor control
--   tokens are skipped; afterwards parsing continues
--
-- * when encountering inline-C code we scan forward over all inline-C and
--   control tokens to avoid turning the control tokens within a sequence of
--   inline-C into Haskell fragments
--
parseFrags      :: [CHSToken] -> CST s [CHSFrag]
parseFrags tokens  = do
                       parseFrags0 tokens
                       `ifError` contFrags tokens
  where
    parseFrags0 :: [CHSToken] -> CST s [CHSFrag]
    parseFrags0 []                         = return []
    parseFrags0 (CHSTokHaskell pos s:toks) = do
                                               frags <- parseFrags toks
                                               return $ CHSVerb s pos : frags
    parseFrags0 (CHSTokCtrl    pos c:toks) = do
                                               frags <- parseFrags toks
                                               return $ CHSVerb [c] pos : frags
    parseFrags0 (CHSTokCPP     pos s nl:toks) = do
                                               frags <- parseFrags toks
                                               return $ CHSCPP s pos nl : frags
    parseFrags0 (CHSTokLine    pos  :toks) = do
                                               frags <- parseFrags toks
                                               return $ CHSLine pos : frags
    parseFrags0 (CHSTokC       pos s:toks) = parseC       pos s      toks
    parseFrags0 (CHSTokHook hkpos:
                 CHSTokImport  pos  :toks) = parseImport  hkpos pos
                                             (removeCommentInHook toks)
    parseFrags0 (CHSTokHook hkpos:
                 CHSTokContext pos  :toks) = parseContext hkpos pos
                                             (removeCommentInHook toks)
    parseFrags0 (CHSTokHook hkpos:
                 CHSTokNonGNU  pos  :toks) = parseNonGNU  hkpos pos
                                             (removeCommentInHook toks)
    parseFrags0 (CHSTokHook hkpos:
                 CHSTokType    pos  :toks) = parseType    hkpos pos
                                             (removeCommentInHook toks)
    parseFrags0 (CHSTokHook hkpos:
                 CHSTokSizeof  pos  :toks) = parseSizeof  hkpos pos
                                             (removeCommentInHook toks)
    parseFrags0 (CHSTokHook hkpos:
                 CHSTokAlignof pos  :toks) = parseAlignof hkpos pos
                                             (removeCommentInHook toks)
    -- TODO: issue 70, add haddock support for enum hook
    parseFrags0 (CHSTokHook hkpos:
                 CHSTokEnum    pos  :toks) = parseEnum    hkpos pos
                                             (removeCommentInHook toks)
    parseFrags0 (CHSTokHook hkpos:
                 CHSTokCall    pos  :toks) = parseCall    hkpos pos
                                             (removeCommentInHook toks)
    parseFrags0 (CHSTokHook hkpos:
                 CHSTokFun     pos  :toks) = parseFun     hkpos pos toks
    parseFrags0 (CHSTokHook hkpos:
                 CHSTokGet     pos  :toks) = parseField   hkpos pos CHSGet
                                             (removeCommentInHook toks)
    parseFrags0 (CHSTokHook hkpos:
                 CHSTokSet     pos  :toks) = parseField   hkpos pos CHSSet
                                             (removeCommentInHook toks)
    parseFrags0 (CHSTokHook hkpos:
                 CHSTokOffsetof pos :toks) = parseOffsetof hkpos pos
                                             (removeCommentInHook toks)
    parseFrags0 (CHSTokHook hkpos:
                 CHSTokClass   pos  :toks) = parseClass   hkpos pos
                                             (removeCommentInHook toks)
    parseFrags0 (CHSTokHook hkpos:
                 CHSTokConst   pos  :toks) = parseConst   hkpos pos
                                             (removeCommentInHook toks)
    parseFrags0 (CHSTokHook hkpos:
                 CHSTokTypedef pos  :toks) = parseTypedef hkpos pos
                                             (removeCommentInHook toks)
    parseFrags0 (CHSTokHook hkpos:
                 CHSTokDefault pos  :toks) = parseDefault hkpos pos
                                             (removeCommentInHook toks)
    parseFrags0 (CHSTokHook hkpos:
                 CHSTokPointer pos  :toks) = parsePointer hkpos pos
                                             (removeCommentInHook toks)
    parseFrags0 (CHSTokHook _       :toks) = syntaxError toks
    parseFrags0 toks                       = syntaxError toks
    --
    -- skip to next Haskell or control token
    --
    contFrags      []                       = return []
    contFrags toks@(CHSTokHaskell _ _:_   ) = parseFrags toks
    contFrags toks@(CHSTokCtrl    _ _:_   ) = parseFrags toks
    contFrags      (_                :toks) = contFrags  toks
    --
    -- Only keep comment in fun hook
    --
    isComment (CHSTokComment _ _) = True
    isComment _                   = False
    isEndHook (CHSTokEndHook _) = True
    isEndHook _                 = False
    removeCommentInHook xs = let (lhs,rhs) = span (not . isEndHook) xs
                             in filter (not . isComment) lhs ++ rhs

parseC :: Position -> String -> [CHSToken] -> CST s [CHSFrag]
parseC pos s toks =
  do
    frags <- collectCtrlAndC toks
    return $ CHSC s pos : frags
  where
    collectCtrlAndC (CHSTokCtrl pos' c :toks') = do
                                                frags <- collectCtrlAndC toks'
                                                return $ CHSC [c] pos' : frags
    collectCtrlAndC (CHSTokC    pos' s':toks') = do
                                                frags <- collectCtrlAndC toks'
                                                return $ CHSC s'  pos' : frags
    collectCtrlAndC toks'                      = parseFrags toks'

parseImport :: Position -> Position -> [CHSToken] -> CST s [CHSFrag]
parseImport hkpos pos toks = do
  (qual, modid, toks') <-
    case toks of
      CHSTokIdent _ ide                :toks' ->
        let (ide', toks'') = rebuildModuleId ide toks'
         in return (False, ide', toks'')
      CHSTokQualif _: CHSTokIdent _ ide:toks' ->
        let (ide', toks'') = rebuildModuleId ide toks'
         in return (True , ide', toks'')
      _                                      -> syntaxError toks
  chi <- loadCHI . moduleNameToFileName . identToString $ modid
  toks'2 <- parseEndHook toks'
  frags <- parseFrags toks'2
  return $ CHSHook (CHSImport qual modid chi pos) hkpos : frags

-- | Qualified module names do not get lexed as a single token so we need to
-- reconstruct it from a sequence of identifer and dot tokens.
--
rebuildModuleId :: Ident -> [CHSToken] -> (Ident, [CHSToken])
rebuildModuleId ide (CHSTokDot _ : CHSTokIdent _ ide' : toks) =
  let catIdent ide'3 ide'4 = internalIdentAt (posOf ide'3)
                                         --FIXME: unpleasant hack
                            (identToString ide'3 ++ '.' : identToString ide'4)
   in rebuildModuleId (catIdent ide ide') toks
rebuildModuleId ide                                     toks  = (ide, toks)

moduleNameToFileName :: String -> FilePath
moduleNameToFileName = map dotToSlash
  where dotToSlash '.' = '/'
        dotToSlash c   = c

parseContext          :: Position -> Position -> [CHSToken] -> CST s [CHSFrag]
parseContext hkpos pos toks  = do
  (olib    , toks2) <- parseOptLib          toks
  (opref   , toks3) <- parseOptPrefix False toks2
  (oreppref, toks4) <- parseOptReplPrefix   toks3
  toks5             <- parseEndHook         toks4
  frags             <- parseFrags           toks5
  let frag = CHSContext olib opref oreppref pos
  return $ CHSHook frag hkpos : frags

parseNonGNU           :: Position -> Position -> [CHSToken] -> CST s [CHSFrag]
parseNonGNU hkpos pos toks  = do
  toks2             <- parseEndHook         toks
  frags             <- parseFrags           toks2
  let frag = CHSNonGNU pos
  return $ CHSHook frag hkpos : frags

parseType :: Position -> Position -> [CHSToken] -> CST s [CHSFrag]
parseType hkpos pos (CHSTokIdent _ ide:toks) =
  do
    toks' <- parseEndHook toks
    frags <- parseFrags toks'
    return $ CHSHook (CHSType ide pos) hkpos : frags
parseType _ _ toks = syntaxError toks

parseSizeof :: Position -> Position -> [CHSToken] -> CST s [CHSFrag]
parseSizeof hkpos pos (CHSTokIdent _ ide:toks) =
  do
    toks' <- parseEndHook toks
    frags <- parseFrags toks'
    return $ CHSHook (CHSSizeof ide pos) hkpos : frags
parseSizeof _ _ toks = syntaxError toks

parseAlignof :: Position -> Position -> [CHSToken] -> CST s [CHSFrag]
parseAlignof hkpos pos (CHSTokIdent _ ide:toks) =
  do
    toks' <- parseEndHook toks
    frags <- parseFrags toks'
    return $ CHSHook (CHSAlignof ide pos) hkpos : frags
parseAlignof _ _ toks = syntaxError toks

parseEnum :: Position -> Position -> [CHSToken] -> CST s [CHSFrag]

-- {#enum define hsid {alias_1,...,alias_n}  [deriving (clid_1,...,clid_n)] #}
parseEnum hkpos pos (CHSTokIdent _ def: CHSTokIdent _ hsid: toks)
  | identToString def == "define" =
  do
    (trans , toks')   <- parseTrans          toks
    (derive, toks'')  <- parseDerive         toks'
    toks'''           <- parseEndHook        toks''
    frags             <- parseFrags          toks'''
    return $ CHSHook (CHSEnumDefine hsid trans derive pos) hkpos : frags

-- {#enum cid [as hsid] {alias_1,...,alias_n}  [with prefix = pref] [deriving (clid_1,...,clid_n)] #}
parseEnum hkpos pos (CHSTokIdent _ ide:toks) =
  do
    (oalias,      toks2) <- parseOptAs ide True toks
    (emit,        toks3) <- parseOptNoCode      toks2
    (trans,       toks4) <- parseTrans          toks3
    (oprefix,     toks5) <- parseOptPrefix True toks4
    (oreplprefix, toks6) <- parseOptReplPrefix  toks5
    (derive,      toks7) <- parseDerive         toks6
    toks8                <- parseEndHook        toks7
    frags                <- parseFrags          toks8
    return $ CHSHook (CHSEnum ide (norm oalias) trans emit
                      oprefix oreplprefix derive pos) hkpos : frags
  where
    norm Nothing                   = Nothing
    norm (Just ide') | ide == ide' = Nothing
                     | otherwise   = Just ide'
parseEnum _ _ toks = syntaxError toks

parseOptNoCode :: [CHSToken] -> CST s (Bool, [CHSToken])
parseOptNoCode (CHSTokNocode _ :toks) = return (False, toks)
parseOptNoCode toks                   = return (True, toks)

parseCall          :: Position -> Position -> [CHSToken] -> CST s [CHSFrag]
parseCall hkpos pos toks  =
  do
    (isPure  , toks'   ) <- parseIsPure          toks
    (isUnsafe, toks''  ) <- parseIsUnsafe        toks'
    (apath   , toks''' ) <- parsePath            toks''
    (oalias  , toks'''') <- parseOptAs (apathToIdent apath) False toks'''
    toks'''''            <- parseEndHook         toks''''
    frags                <- parseFrags           toks'''''
    return $
      CHSHook (CHSCall isPure isUnsafe apath oalias pos) hkpos : frags

parseFun          :: Position -> Position -> [CHSToken] -> CST s [CHSFrag]
parseFun hkpos pos inputToks  =
  do
    (isPure  , toks' ) <- parseIsPure          toks
    (isUnsafe, toks'2) <- parseIsUnsafe        toks'
    (isVar,    toks'3) <- parseIsVariadic      toks'2
    (apath   , toks'4) <- parsePath            toks'3
    (varTypes, toks'5) <- parseVarTypes        toks'4
    (oalias  , toks'6) <- parseOptAs (apathToIdent apath) False toks'5
    (octxt   , toks'7) <- parseOptContext      toks'6
    (parms   , toks'8) <- parseParms           toks'7
    (parm    , toks'9) <- parseParm            toks'8
    when (isParmWrapped parm) $ errorOutWrap $ head toks'8
    toks'10            <- parseEndHook         toks'9
    frags              <- parseFrags           toks'10
    return $
      CHSHook
        (CHSFun isPure isUnsafe isVar varTypes
         apath oalias octxt parms parm pos) hkpos :
      frags
  where
    toks = removeIllPositionedComment inputToks
    parseOptContext (CHSTokHSVerb _ ctxt:CHSTokDArrow _:toks') =
      return (Just ctxt, toks')
    parseOptContext toks'                                      =
      return (Nothing  , toks')
    --
    parseVarTypes (CHSTokLBrack _:CHSTokCArg _ t:toks') = do
      (ts, toks'2) <- parseVarTypes' toks'
      return (t:ts, toks'2)
    parseVarTypes toks' = return ([], toks')
    parseVarTypes' (CHSTokRBrack _:toks') = return ([], toks')
    parseVarTypes' (CHSTokComma _:CHSTokCArg _ t:toks') = do
      (ts, toks'2) <- parseVarTypes' toks'
      return (t:ts, toks'2)
    --
    parseParms (CHSTokLBrace _:CHSTokRBrace _:CHSTokArrow _:toks') =
      return ([], toks')
    parseParms (CHSTokLBrace _                             :toks') =
      parseParms' (CHSTokComma nopos:toks')
    parseParms                                              toks'  =
      syntaxError toks'
    --
    parseParms' (CHSTokRBrace _:CHSTokArrow _:toks') = return ([], toks')
    parseParms' (CHSTokComma _:CHSTokComment _ _:toks') = do
      (parm , toks'2 ) <- parseParm   toks'
      (parms, toks'3)  <- parseParms' toks'2
      return (parm:parms, toks'3)
    parseParms' (CHSTokComma _               :toks') = do
      (parm , toks'2 ) <- parseParm   toks'
      (parms, toks'3)  <- parseParms' toks'2
      return (parm:parms, toks'3)
    parseParms' (CHSTokRBrace _              :toks') = syntaxError toks'
      -- gives better error messages
    parseParms'                               toks'  = syntaxError toks'
    --
    isComment (CHSTokComment _ _) = True
    isComment _ = False
    isLBrace (CHSTokLBrace _) = True
    isLBrace _ = False
    isRBrace (CHSTokRBrace _) = True
    isRBrace _ = False
    isHSVerb (CHSTokHSVerb _ _) = True
    isHSVerb _ = False
    -- remove comment(s) between
    -- 1. {# and {
    -- 2. } and `ResultType'
    removeIllPositionedComment xs = let (lhs,rhs) = span (not . isLBrace) xs
                                        (lhs',rhs') = span (not . isRBrace) rhs
                                        (lhs'2,rhs'2) = span (not . isHSVerb) rhs'
                                    in filter (not . isComment) lhs ++ lhs' ++
                                       (filter (not . isComment) lhs'2) ++ rhs'2

parseIsPure :: [CHSToken] -> CST s (Bool, [CHSToken])
parseIsPure (CHSTokPure _:toks) = return (True , toks)
parseIsPure (CHSTokFun  _:toks) = return (True , toks)  -- backwards compat.
parseIsPure toks                = return (False, toks)
-- FIXME: eventually, remove `fun'; it's currently deprecated

parseIsUnsafe :: [CHSToken] -> CST s (Bool, [CHSToken])
parseIsUnsafe (CHSTokUnsafe _:toks) = return (True , toks)
parseIsUnsafe toks                  = return (False, toks)

parseIsVariadic :: [CHSToken] -> CST s (Bool, [CHSToken])
parseIsVariadic (CHSTokVariadic _:toks) = return (True , toks)
parseIsVariadic toks                    = return (False, toks)

apathToIdent :: CHSAPath -> Ident
apathToIdent (CHSRoot _ ide) =
    let lowerFirst (c:cs) = toLower c : cs
    in internalIdentAt (posOf ide) (lowerFirst $ identToString ide)
apathToIdent (CHSDeref apath _) =
    let ide = apathToIdent apath
    in internalIdentAt (posOf ide) (identToString ide ++ "_")
apathToIdent (CHSRef apath ide') =
    let ide = apathToIdent apath
        upperFirst (c:cs) = toLower c : cs
        sel = upperFirst $ identToString ide'
    in internalIdentAt  (posOf ide) (identToString ide ++ sel)

apathRootIdent :: CHSAPath -> Ident
apathRootIdent (CHSRoot _ ide) = ide
apathRootIdent (CHSDeref apath _) = apathRootIdent apath
apathRootIdent (CHSRef apath _) = apathRootIdent apath

parseParm :: [CHSToken] -> CST s (CHSParm, [CHSToken])
parseParm (CHSTokPlus _:toks') = return (CHSPlusParm, toks')
parseParm toks =
  do
    (oimMarsh, toks' ) <- parseOptMarsh toks
    let (wrapped, toks'') = case toks' of
          (CHSTokPercent _:tokstmp) -> (True,  tokstmp)
          _                         -> (False, toks')
    (hsTyStr, twoCVals, pos, toks'2) <-
      case toks'' of
        (CHSTokHSVerb pos hsTyStr:CHSTokAmp _:toks'2) ->
          return (hsTyStr, True , pos, toks'2)
        (CHSTokHSVerb pos hsTyStr            :toks'2) ->
          return (hsTyStr, False, pos, toks'2)
        _toks                                          -> syntaxError toks''
    (oomMarsh, toks'3) <- parseOptMarsh toks'2
    (comments, toks'4) <- parseOptComments toks'3
    return (CHSParm oimMarsh hsTyStr twoCVals oomMarsh wrapped pos
            (concat (intersperse " " comments)), toks'4)
  where
    parseOptMarsh :: [CHSToken] -> CST s (CHSMarsh, [CHSToken])
    parseOptMarsh (CHSTokIdent _ ide:toks') =
      do
        (marshType, toks'2) <- parseOptMarshType toks'
        return (Just (Left ide, marshType), toks'2)
    parseOptMarsh (CHSTokHSQuot _ str:toks') =
      do
        (marshType, toks'2) <- parseOptMarshType toks'
        return (Just (Right str, marshType), toks'2)
    parseOptMarsh (CHSTokWith _ ide:toks') =
      do
        (marshType, toks'2) <- parseOptMarshType toks'
        return (Just (Left ide, marshType), toks'2)
    parseOptMarsh toks'                     =
      return (Nothing, toks')

    parseOptMarshType (CHSTokStar _ :CHSTokMinus _:toks') =
      return (CHSIOVoidArg , toks')
    parseOptMarshType (CHSTokStar _ :toks') =
      return (CHSIOArg , toks')
    parseOptMarshType (CHSTokMinus _:toks') =
      return (CHSVoidArg, toks')
    parseOptMarshType toks' =
      return (CHSValArg, toks')

parseOptComments :: [CHSToken] -> CST s ([String], [CHSToken])
parseOptComments = go []
  where
    go acc (CHSTokComment _ s:toks) = go (s:acc) toks
    go acc _toks = return (reverse acc,_toks)

parseField :: Position -> Position -> CHSAccess -> [CHSToken] -> CST s [CHSFrag]
parseField hkpos pos access toks =
  do
    (path, toks') <- parsePath  toks
    toks''        <- parseEndHook toks'
    frags         <- parseFrags toks''
    return $ CHSHook (CHSField access path pos) hkpos : frags

parseOffsetof :: Position -> Position -> [CHSToken] -> CST s [CHSFrag]
parseOffsetof hkpos pos toks =
  do
    (path, toks') <- parsePath toks
    toks''        <- parseEndHook toks'
    frags         <- parseFrags toks''
    return $ CHSHook (CHSOffsetof path pos) hkpos : frags

parsePointer :: Position -> Position -> [CHSToken] -> CST s [CHSFrag]
parsePointer hkpos pos toks = do
    (isStar, ide, toks')          <-
      case toks of
        CHSTokStar _:CHSTokIdent _ ide:toks' -> return (True , ide, toks')
        CHSTokIdent _ ide             :toks' -> return (False, ide, toks')
        _                                    -> syntaxError toks
    (oalias , toks'2)             <- parseOptAs ide True toks'
    (ptrType, toks'3)             <- parsePtrType        toks'2
    let
     (isNewtype, oRefType, toks'4) =
      case toks'3 of
        CHSTokNewtype _                   :toks'' -> (True , [] , toks'' )
        CHSTokArrow   _:CHSTokIdent _ ide':toks'' ->
          let (ides, toks''') = span isIde toks''
              isIde (CHSTokIdent _ _) = True
              isIde _                 = False
              takeId (CHSTokIdent _ i) = i
          in (False, ide':map takeId ides, toks''')
        CHSTokArrow   _:CHSTokHSVerb _ hs:toks'' ->
          (False, map internalIdent $ words hs, toks'')
        _                                         -> (False, [] , toks'3)
    let
     (emit, toks'5) =
      case toks'4 of
        CHSTokNocode _                  :toks'' -> (False, toks'' )
        _                                       -> (True , toks'4 )
    toks'6                        <- parseEndHook toks'5
    frags                         <- parseFrags   toks'6
    return $
      CHSHook
       (CHSPointer
         isStar ide (norm ide oalias) ptrType isNewtype
         oRefType emit pos) hkpos
       : frags
  where
    parsePtrType :: [CHSToken] -> CST s (CHSPtrType, [CHSToken])
    parsePtrType (CHSTokForeign _:toks') = do
      (final, toks'') <- parseFinalizer toks'
      return (CHSForeignPtr final, toks'')
    parsePtrType (CHSTokStable _ :toks') = return (CHSStablePtr, toks')
    parsePtrType                  toks'  = return (CHSPtr, toks')

    parseFinalizer (CHSTokFinal _ : CHSTokIdent _ ide : toks') = do
      (oalias, toks'') <- parseOptAs ide False toks'
      return (Just (ide, oalias), toks'')
    parseFinalizer toks' = return (Nothing, toks')

    norm _   Nothing                   = Nothing
    norm ide (Just ide') | ide == ide' = Nothing
                         | otherwise   = Just ide'

parseClass :: Position -> Position -> [CHSToken] -> CST s [CHSFrag]
parseClass hkpos pos (CHSTokIdent  _ sclassIde:
                CHSTokDArrow _          :
                CHSTokIdent  _ classIde :
                CHSTokIdent  _ typeIde  :
                toks)                     =
  do
    toks' <- parseEndHook toks
    frags <- parseFrags toks'
    return $ CHSHook (CHSClass (Just sclassIde)
                      classIde typeIde pos) hkpos : frags
parseClass hkpos pos (CHSTokIdent _ classIde :
                      CHSTokIdent _ typeIde  :
                      toks)                     =
  do
    toks' <- parseEndHook toks
    frags <- parseFrags toks'
    return $ CHSHook (CHSClass Nothing classIde typeIde pos) hkpos : frags
parseClass _ _ toks = syntaxError toks

parseConst :: Position -> Position -> [CHSToken] -> CST s [CHSFrag]
parseConst hkpos pos (CHSTokIdent  _ constIde : toks)                     =
  do
    toks' <- parseEndHook toks
    frags <- parseFrags toks'
    return $ CHSHook (CHSConst constIde pos) hkpos : frags
parseConst _ _ toks = syntaxError toks

parseTypedef :: Position -> Position -> [CHSToken] -> CST s [CHSFrag]
parseTypedef hkpos pos (CHSTokIdent _ cIde : CHSTokIdent _ hsIde :
                        CHSTokEndHook _ : toks) =
  do
    frags <- parseFrags toks
    return $ CHSHook (CHSTypedef cIde hsIde pos) hkpos : frags
parseTypedef _ _ toks = syntaxError toks

parseDefault :: Position -> Position -> [CHSToken] -> CST s [CHSFrag]
parseDefault hkpos pos
  toks@(dirtok :
        CHSTokHSVerb _ hsTy :
        CHSTokLBrack _ :
        CHSTokCArg _ cTyIn :
        CHSTokRBrack _ :
        toks1) =
  do
    dir <- case dirtok of
      CHSTokIn _  -> return In
      CHSTokOut _ -> return Out
      _           -> syntaxError toks
    (marsh, toks2) <- parseMarshaller toks1
    let trim = reverse . dropWhile isSpace . reverse . dropWhile isSpace
        cTy' = trim cTyIn
        (cTy, cPtr) = if last cTy' == '*'
                      then (trim $ init cTy', True)
                      else (cTy', False)
    toks3 <- parseEndHook toks2
    frags <- parseFrags toks3
    return $ CHSHook (CHSDefault dir hsTy cTy cPtr marsh pos) hkpos : frags
  where parseMarshaller :: [CHSToken]
                         -> CST s ((Either Ident String, CHSArg), [CHSToken])
        parseMarshaller (CHSTokIdent _ mide : toks') = do
            (hasStar, toks'') <- parseOptStar toks'
            let argtype = if hasStar then CHSIOArg else CHSValArg
            return ((Left mide, argtype), toks'')
        parseMarshaller toks' = syntaxError toks'
parseDefault _ _ toks = syntaxError toks

parseOptStar :: [CHSToken] -> CST s (Bool, [CHSToken])
parseOptStar (CHSTokStar _ : toks) = return (True, toks)
parseOptStar toks = return (False, toks)

parseOptLib :: [CHSToken] -> CST s (Maybe String, [CHSToken])
parseOptLib (CHSTokLib    _    :
             CHSTokEqual  _    :
             CHSTokString _ str:
             toks)                = return (Just str, toks)
parseOptLib (CHSTokLib _:toks   ) = syntaxError toks
parseOptLib toks                  = return (Nothing, toks)

parseOptPrefix :: Bool -> [CHSToken] -> CST s (Maybe String, [CHSToken])
parseOptPrefix False (CHSTokPrefix _    :
                      CHSTokEqual  _    :
                      CHSTokString _ str:
                      toks)                = return (Just str, toks)
parseOptPrefix True  (CHSTokWith   _ _  :
                      CHSTokPrefix _    :
                      CHSTokEqual  _    :
                      CHSTokString _ str:
                      toks)                = return (Just str, toks)
parseOptPrefix _     (CHSTokWith _ _:toks) = syntaxError toks
parseOptPrefix _     (CHSTokPrefix _:toks) = syntaxError toks
parseOptPrefix _     toks                  = return (Nothing, toks)

parseOptReplPrefix :: [CHSToken] -> CST s (Maybe String, [CHSToken])
parseOptReplPrefix (CHSTokAdd   _    :
                    CHSTokPrefix _    :
                    CHSTokEqual  _    :
                    CHSTokString _ str:
                    toks)                = return (Just str, toks)
parseOptReplPrefix (CHSTokAdd    _:toks) = syntaxError toks
parseOptReplPrefix (CHSTokPrefix _:toks) = syntaxError toks
parseOptReplPrefix toks                  = return (Nothing, toks)

-- first argument is the identifier that is to be used when `^' is given and
-- the second indicates whether the first character has to be upper case
--
parseOptAs :: Ident -> Bool -> [CHSToken] -> CST s (Maybe Ident, [CHSToken])
parseOptAs _   _     (CHSTokAs _:CHSTokIdent _ ide:toks) =
  return (Just ide, toks)
parseOptAs _   _     (CHSTokAs _:CHSTokHSQuot pos ide:toks) =
  return (Just $ internalIdentAt pos ide, toks)
parseOptAs ide upper (CHSTokAs _:CHSTokHat pos    :toks) =
  return (Just $ underscoreToCase ide upper pos, toks)
parseOptAs _   _     (CHSTokAs _                  :toks) = syntaxError toks
parseOptAs _   _                                   toks  =
  return (Nothing, toks)

-- | convert C style identifier to Haskell style identifier
--
underscoreToCase               :: Ident -> Bool -> Position -> Ident
underscoreToCase ide upper pos  =
  let lexeme = identToString ide
      ps     = filter (not . null) . parts $ lexeme
  in
  internalIdentAt pos . adjustHead . concat . map adjustCase $ ps
  where
    parts s = let (l, s') = break (== '_') s
              in
              l : case s' of
                    []      -> []
                    (_:s'') -> parts s''
    --
    adjustCase ""     = ""
    adjustCase (c:cs) = toUpper c : cs
    --
    adjustHead ""     = ""
    adjustHead (c:cs) = if upper then toUpper c : cs else toLower c:cs

-- | this is disambiguated and left factored
--
parsePath :: [CHSToken] -> CST s (CHSAPath, [CHSToken])
parsePath (CHSTokLParen _pos: toks) =
  do
    (inner_path, toks_rest) <- parsePath toks
    toks_rest' <- case toks_rest of
                    (CHSTokRParen _pos' : ts) -> return ts
                    _ -> syntaxError toks_rest
    (pathWithHole, toks') <- parsePath' toks_rest'
    return (pathWithHole inner_path, toks')
parsePath (CHSTokStar pos:toks) =
  do
    (path, toks') <- parsePath toks
    return (CHSDeref path pos, toks')
parsePath (CHSTokStruct _pos:tok:toks) =
  case keywordToIdent tok of
    (CHSTokIdent _ ide) ->
      do
        (pathWithHole, toks') <- parsePath' toks
        return (pathWithHole (CHSRoot True ide), toks')
    _ -> syntaxError (tok:toks)
parsePath (tok:toks) =
  case keywordToIdent tok of
    (CHSTokIdent _ ide) ->
      do
        (pathWithHole, toks') <- parsePath' toks
        return (pathWithHole (CHSRoot False ide), toks')
    _ -> syntaxError (tok:toks)
parsePath toks = syntaxError toks

-- | @s->m@ is represented by @(*s).m@ in the tree
--
parsePath' :: [CHSToken] -> CST s (CHSAPath -> CHSAPath, [CHSToken])
parsePath' tokens@(CHSTokDot _:desig:toks) =
  do
    ide <- case keywordToIdent desig of CHSTokIdent _ i -> return i; _ -> syntaxError tokens
    (pathWithHole, toks') <- parsePath' toks
    return (pathWithHole . (\hole -> CHSRef hole ide), toks')
parsePath' tokens@(CHSTokArrow pos:desig:toks) =
  do
    ide <- case keywordToIdent desig of CHSTokIdent _ i -> return i; _ -> syntaxError tokens
    (pathWithHole, toks') <- parsePath' toks
    return (pathWithHole . (\hole -> CHSRef (CHSDeref hole pos) ide), toks')
parsePath' toks =
    return (id,toks)

parseTrans :: [CHSToken] -> CST s (CHSTrans, [CHSToken])
parseTrans (CHSTokLBrace _:toks) =
  do
    (_2Case, chgCase, toks' ) <- parse_2CaseAndChange toks
    case toks' of
      (CHSTokRBrace _:toks'2) -> do
        (omits, toks'3) <- parseOmits toks'2
        return (CHSTrans _2Case chgCase [] omits, toks'3)
      _                       ->
        do
          -- if there was no `underscoreToCase', we add a comma token to meet
          -- the invariant of `parseTranss'
          --
          (transs, toks'2) <- if (_2Case || chgCase /= CHSSameCase)
                              then parseTranss toks'
                              else parseTranss (CHSTokComma nopos:toks')
          (omits, toks'3) <- parseOmits toks'2
          return (CHSTrans _2Case chgCase transs omits, toks'3)
  where
    parse_2CaseAndChange (CHSTok_2Case _:CHSTokComma _:CHSTokUpper _:toks') =
      return (True, CHSUpCase, toks')
    parse_2CaseAndChange (CHSTok_2Case _:CHSTokComma _:CHSTokDown _ :toks') =
      return (True, CHSDownCase, toks')
    parse_2CaseAndChange (CHSTok_2Case _                            :toks') =
      return (True, CHSSameCase, toks')
    parse_2CaseAndChange (CHSTokUpper _:CHSTokComma _:CHSTok_2Case _:toks') =
      return (True, CHSUpCase, toks')
    parse_2CaseAndChange (CHSTokUpper _                             :toks') =
      return (False, CHSUpCase, toks')
    parse_2CaseAndChange (CHSTokDown  _:CHSTokComma _:CHSTok_2Case _:toks') =
      return (True, CHSDownCase, toks')
    parse_2CaseAndChange (CHSTokDown  _                             :toks') =
      return (False, CHSDownCase, toks')
    parse_2CaseAndChange toks'                                              =
      return (False, CHSSameCase, toks')
    --
    parseTranss (CHSTokRBrace _:toks') = return ([], toks')
    parseTranss (CHSTokComma  _:toks') = do
                                        (assoc, toks'2 ) <- parseAssoc toks'
                                        (trans, toks'3) <- parseTranss toks'2
                                        return (assoc:trans, toks'3)
    parseTranss toks'                  = syntaxError toks'
    --
    parseOmits (CHSTokOmit _:CHSTokLParen _:CHSTokIdent _ omit:toks') = do
      (omits, toks'2) <- parseOmits1 toks'
      return (omit:omits, toks'2)
    parseOmits toks' = return ([], toks')
    --
    parseOmits1 (CHSTokRParen _:toks') = return ([], toks')
    parseOmits1 (CHSTokComma _:CHSTokIdent _ omit:toks') = do
      (omits, toks'2) <- parseOmits1 toks'
      return (omit:omits, toks'2)
    parseOmits1 toks' = syntaxError toks'
    --
    parseAssoc (CHSTokIdent _ ide1:CHSTokAs _:CHSTokIdent _ ide2:toks') =
      return ((ide1, ide2), toks')
    parseAssoc (CHSTokCIdentTail _ ide1:CHSTokAs _:CHSTokIdent _ ide2:toks') =
      return ((ide1, ide2), toks')
    parseAssoc (CHSTokIdent _ _   :CHSTokAs _:toks'                   ) =
      syntaxError toks'
    parseAssoc (CHSTokIdent _ _   :toks'                              ) =
      syntaxError toks'
    parseAssoc toks'                                                    =
      syntaxError toks'
parseTrans toks = syntaxError toks

parseDerive :: [CHSToken] -> CST s ([Ident], [CHSToken])
parseDerive (CHSTokDerive _ :CHSTokLParen _:CHSTokRParen _:toks) =
  return ([], toks)
parseDerive (CHSTokDerive _ :CHSTokLParen _:toks)                =
  parseCommaIdent (CHSTokComma nopos:toks)
  where
    parseCommaIdent :: [CHSToken] -> CST s ([Ident], [CHSToken])
    parseCommaIdent (CHSTokComma _:CHSTokIdent _ ide:toks') =
      do
        (ids, tok') <- parseCommaIdent toks'
        return (ide:ids, tok')
    parseCommaIdent (CHSTokRParen _                :toks') =
      return ([], toks')
parseDerive toks = return ([],toks)

parseEndHook :: [CHSToken] -> CST s ([CHSToken])
parseEndHook (CHSTokEndHook _:toks) = return toks
parseEndHook toks                   = syntaxError toks

syntaxError         :: [CHSToken] -> CST s a
syntaxError []       = errorEOF
syntaxError (tok:_)  = errorIllegal tok

errorIllegal     :: CHSToken -> CST s a
errorIllegal tok  = do
                      raiseError (posOf tok)
                        ["Syntax error!",
                         "The phrase `" ++ show tok ++ "' is not allowed \
                         \here."]
                      raiseSyntaxError

errorEOF :: CST s a
errorEOF  = do
              raiseError nopos
                ["Premature end of file!",
                 "The .chs file ends in the middle of a binding hook."]
              raiseSyntaxError

errorOutWrap :: CHSToken -> CST s a
errorOutWrap tok = do
  raiseError (posOf tok)
    ["Syntax error!",
     "Structure wrapping is not allowed for return parameters."]
  raiseSyntaxError

errorCHICorrupt      :: String -> CST s a
errorCHICorrupt ide  = do
  raiseError nopos
    ["Corrupt .chi file!",
     "The file `" ++  ide ++ ".chi' is corrupt."]
  raiseSyntaxError

errorCHIVersion :: String -> String -> String -> CST s a
errorCHIVersion ide chiVersion myVersion  = do
  raiseError nopos
    ["Wrong version of .chi file!",
     "The file `" ++ ide ++ ".chi' is version "
     ++ chiVersion ++ ", but mine is " ++ myVersion ++ "."]
  raiseSyntaxError


text:
import unittest

from stratuslab.pdiskbackend.utils import EXITCODE_PDISK_OP_FAILED

from stratuslab.pdiskbackend.backends.Backend import Backend
from stratuslab.pdiskbackend.backends.BackendCommand import BackendCommand

class BackendTest(unittest.TestCase):

    def setUp(self):
        pass

    def tearDown(self):
        pass

    def test_getCmd_missing_action(self):
        backend = Backend()
        try:
            backend.getCmd('').next()
        except SystemExit as ex:
            assert ex.code == EXITCODE_PDISK_OP_FAILED
        else:
            self.fail('Should have raised SystemExit')

    def test_getCmd_default_actions(self):
        for action in Backend.lun_backend_cmd_mapping.keys():
            backend = Backend()
            assert None == backend.getCmd(action).next()

    def test_getCmd(self):
        _lun_backend_cmd_mapping = Backend.lun_backend_cmd_mapping.copy()
        _backend_cmds = Backend.backend_cmds.copy()

        Backend.lun_backend_cmd_mapping.update({'check': ['foo']})
        Backend.backend_cmds = {'foo': ['bar']}
        Backend._type = 'baz'
        try:
            backend = Backend()
            backendCmd = backend.getCmd('check').next()

            assert None != backendCmd
            assert isinstance(backendCmd, BackendCommand)

            assert ['bar'] == backendCmd.command
        finally:
            Backend.lun_backend_cmd_mapping = _lun_backend_cmd_mapping
            Backend.backend_cmds = _backend_cmds

if __name__ == "__main__":
    unittest.main()

redpajama_set_name: RedPajamaGithub


text:
'use strict';
import getYoRcPath from 'get-yo-rc-path';
import path from 'path';
import removeTrailingSlash from 'remove-trailing-slash';

/**
 * Return JSON contents of file name from root
 * @param {String} fileName - name of file to read
 * @returns {Promise<Object>} - file contents
 */
/* eslint-disable space-before-function-paren */
const getFileFromRoot = async fileName =>
  /* eslint-enable space-before-function-paren */
  /* eslint-disable global-require */
  require(path.join(await getYoRcPath.dir(), fileName));
  /* eslint-enable global-require */

/**
 * Return build config
 * @returns {Promise<Object>} - build config
 */
const getBuildConfig = () =>
  getFileFromRoot('build.config.js');

module.exports = {
  getFileFromRoot,

  /**
   * Gets the appDir from the root build.config.js without trailing / or \
   * @return {Promise<String>} - app directory path
   */
  async getAppDir() {
    return removeTrailingSlash((await getBuildConfig()).appDir);
  },

  /**
   * Gets the unitTestDir from the root build.config.js
   * @return {Promise<String>} - unit test directory path
   */
  async getUnitTestDir() {
    return (await getBuildConfig()).unitTestDir;
  }
};


text:
const chalk = require('chalk')
const stringWidth = require('string-width')

// Ours
const display = require('./display')
const { forEachProp } = require('./.internal/util')

const cBlock = '\u2588'
const cLine = '\u2504'
const indent = '  '
const columns = process.stdout.columns
const padded = columns - indent.length * 2

const showCategories = categories => {
  const catColors = {
    scripting: chalk.yellow,
    rendering: chalk.magenta,
    painting: chalk.green
  }

  // Sum all the timings
  let totalTime = 0
  forEachProp(categories, time => { totalTime += time })

  console.log(`${indent}${display.section('Repartition')}\n`)

  // Display a rep bar
  process.stdout.write(indent)
  forEachProp(categories, (time, cat) => {
    const blocks = Math.round(time / totalTime * padded)
    process.stdout.write(catColors[cat](cBlock.repeat(blocks)))
  })
  process.stdout.write('\n\n')

  // Display legend
  process.stdout.write(indent)
  forEachProp(categories, (time, cat) => {
    const duration = display.value(time, 'ms')
    const block = catColors[cat](cBlock)
    const output = `${block} ${cat} ${duration}`
    const fill = ' '.repeat(padded / 3 - stringWidth(output))
    process.stdout.write(output + fill)
  })
  process.stdout.write('\n\n')
}

const showFunctions = functions => {
  const userFnSignature = /f:(\w+)@/

  console.log(`${indent}${display.section('Functions')}\n`)

  forEachProp(functions, (time, fnName) => {
    // exclude functions at 0ms
    if (time < 1) return

    // exclude all nonuser functions
    const match = fnName.match(userFnSignature)
    if (!match) return

    fnName = match[1]
    const duration = display.value(time, 'ms')
    console.log(`${indent}${fnName} ${duration}`)
  })
}

const showReport = report => {
  console.log(`\n${display.subtle(cLine.repeat(columns))}`)
  console.log(`\n${display.emphasis(report.title)}\n`)

  showCategories(report.profiling.categories)
  showFunctions(report.profiling.functions)
}

module.exports = showReport


text:
module OutputHelper
  def quote(string)
    string.to_s.inspect unless string.nil?
  end

  def print_ruby_object(object)
    object.ai(plain: true)
  end
end


text:
<form class="form-horizontal">

      <legend>Detalhe Solicitação</legend>

      Solicitante
      <input disabled type="text" class="form-control" id="solicitante" style="width: 50%"
             value="Andrei Richard de los Santos de Andrade">

      Matrícula
      <input disabled type="text" class="form-control" id="matricula" style="width: 50%" value="10070128">

      Data Solicitação
      <input disabled type="date" class="form-control" id="dataSolicitacao" style="width: 50%" value="1995-01-20">

      Curso
      <input disabled type="text" class="form-control" id="curso" style="width: 50%"
             value="Análie e Desenvolvimento de Sistemas">

      Disciplina
      <input disabled type="text" class="form-control" id="disciplina" style="width: 50%" value="Desenvolimento 1">

      Tipo Solicitação
      <input disabled type="text" class="form-control" id="tipoSolicitacao" style="width: 50%"
             value="Prova de Certificação">

      Motivo
      <textarea disabled rows="10" class="form-control" id="motivo" style="resize: none">Motivo</textarea>

      Anexo

          #
          Nome do Arquivo
          Tamanho
          Remover

          1
          Arquivo
          15kb
          Deletar

          2
          Arquivo
          15kb
          Deletar

          3
          Arquivo
          15kb
          Deletar

      <legend>Observações</legend>

      20/01/1995
      Andrei Richard de los Santos de Andrade
      <textarea disabled rows="3" class="form-control" id="motivo" style="resize: none">Motivo</textarea>

      <button class="btn btn-primary col-lg-5 pull-left">Aprovar</button>
      <button class="btn btn-danger col-lg-5 pull-right">Rejeitar</button>

</form>


text:
@interface LSFormDateUnqualifyCell : LSFormCell{

}
@property (nonatomic, strong)UIView         *viewBG;
@property (nonatomic, strong)UILabel        *labelTitle;
@property (nonatomic, strong)UILabel        *labelContent;

@property (nonatomic, copy)NSString         *strTitle;

@property (nonatomic, copy)NSString         *dateTimeType;

@property(nonatomic,retain) NSString *dateFormat;

@property (nonatomic, assign)UIDatePickerMode type;

+ (NSDictionary *)mapperWithCellName:(NSString *)cellName keyName:(NSString *)keyName label:(NSString *)label dateType:(NSString *)dateType;
@end


text:
/*
 *  test_iotdb.js
 *
 *  David Janes
 *  IOTDB
 *  2016-02-03
 */

"use strict";

var assert = require("assert")
var _ = require("../helpers")

var iotdb = require("../iotdb");

require('./instrument/iotdb');

describe('test_iotdb', function() {
    describe('constructor', function() {
        it('global', function() {
            assert.ok(iotdb.iot());
        });
        it('global returns same object', function() {
            assert.strictEqual(iotdb.iot(), iotdb.iot());
        });
    });
});


text:
namespace fs = boost::filesystem;

AnalyticsTasks AnalyticsTasks::__tasks_;

void AnalyticsTasks::initialize() {
    std::vector<Param> params;
    params.push_back(Param("maxiter", INT, "100"));
    params.push_back(Param("eps", DOUBLE, "0"));
    params.push_back(Param("C", DOUBLE, "0.85"));
    tasks.insert(std::make_pair("pagerank", Task("pagerank", params)));

    params.clear();
    params.push_back(Param("maxiter", INT, "20"));
    tasks.insert(std::make_pair("hits", Task("hits", params)));

    params.clear();
    params.push_back(Param("nodefrac", DOUBLE, "1.0"));
    tasks.insert(std::make_pair("betcentr", Task("betcentr", params)));

    params.clear();
    params.push_back(Param("samplen", INT, "-1"));
    tasks.insert(std::make_pair("avg_clustcoef", Task("avg_clustcoef", params)));

    params.clear();
    tasks.insert(std::make_pair("clustcoef", Task("clustcoef", params)));

    params.clear();
    params.push_back(Param("samplen", INT, "-1"));
    tasks.insert(std::make_pair("triads", Task("triads", params)));

    params.clear();
    tasks.insert(std::make_pair("triangles", Task("triangles", params)));

    params.clear();
    params.push_back(Param("src", LONG, ""));
    params.push_back(Param("dst", LONG, ""));
    params.push_back(Param("pairs", PATH, ""));
    tasks.insert(std::make_pair("bfs", Task("bfs", params)));

    params.clear();
    params.push_back(Param("testnodes", INT, "-1"));
    tasks.insert(std::make_pair("diameter", Task("diameter", params)));

    params.clear();
    params.push_back(Param("nodes", PATH, ""));
    tasks.insert(std::make_pair("mod", Task("mod", params)));

    params.clear();
    tasks.insert(std::make_pair("maxwcc", Task("maxwcc", params)));

    params.clear();
    tasks.insert(std::make_pair("maxscc", Task("maxscc", params)));

    params.clear();
    params.push_back(Param("nodes", PATH, ""));
    params.push_back(Param("node", LONG, "-1"));
    params.push_back(Param("len", LONG, ""));
    tasks.insert(std::make_pair("rw", Task("rw", params)));

    init = true;
}

string AnalyticsTasks::getTaskDetails() {
    string out = "";
    for(auto task : tasks) {
        out += "TASK: " + task.first + " PARAMS:\n";
        for(auto param : task.second.params) {
            out += "  name=" + param.name + "  typ=" + getStringType(param.type) + "  def=" + param.defvalue + "\n";
        }
    }
    return out;
}

string AnalyticsTasks::getStringType(TYPE t) {
    switch (t) {
        case LONG:
            return "long";
        case INT:
            return "int";
        case DOUBLE:
            return "double";
        case BOOL:
            return "bool";
        case PATH:
            return "path";
        default:
            return "unknown";
    }
}

void AnalyticsTasks::load(string nametask, string raw) {
    if (raw == "")
        return;

    istringstream f(raw);
    string s;
    while (getline(f, s, ';')) {
        size_t pos = s.find("=");
        if (pos == string::npos) {
            BOOST_LOG_TRIVIAL(error) << "Param string not well-formed";
            throw 10;
        }
        string nameparam = s.substr(0, pos);
        string valueparam = s.substr(pos + 1, s.length());
        if (nameparam.empty() || valueparam.empty()) {
            BOOST_LOG_TRIVIAL(error) << "Name or value params are empty";
            throw 10;
        }

        auto task = tasks.find(nametask);
        if (task == tasks.end()) {
            BOOST_LOG_TRIVIAL(error) << "Param task " << nametask << " not found";
            throw 10;
        }
        task->second.updateParam(nameparam, valueparam);
    }
}

AnalyticsTasks::Param &AnalyticsTasks::Task::getParam(string nameparam) {
    for(int i = 0; i < params.size(); ++i) {
        if (params[i].name == nameparam)
            return params[i];
    }
    BOOST_LOG_TRIVIAL(error) << "Param " << nameparam << " not found";
    throw 10;
}

void AnalyticsTasks::Task::updateParam(string nameparam, string valueparam) {
    Param &p = getParam(nameparam);
    p.set(valueparam);
}

string AnalyticsTasks::Task::tostring() {
    string out = name + " ";
    for (auto p : params) {
        out += p.name + "=" + p.getRawValue() + " ";
    }
    return out;
}

void AnalyticsTasks::Param::set(string value) {
    //Check the type
    try {
        switch (type) {
            case DOUBLE:
                boost::lexical_cast<double>(value);
                break;
            case INT:
                boost::lexical_cast<int>(value);
                break;
            case LONG:
                boost::lexical_cast<long>(value);
                break;
            case BOOL:
                boost::lexical_cast<bool>(value);
                break;
            case PATH:
                if (!fs::exists(fs::path(value))) {
                    BOOST_LOG_TRIVIAL(error) << "Path " << value << " does not exist";
                    throw 10;
                }
                break;
        }
    } catch (boost::bad_lexical_cast &) {
        BOOST_LOG_TRIVIAL(error) << "Failed conversion of " << value;
        throw 10;
    }
    this->value = value;
}


text:
[![CI Status](http://img.shields.io/travis/skyweb07/SKKeyboardResigner.svg?style=flat)](https://travis-ci.org/skyweb07/SKKeyboardResigner)
[![Version](https://img.shields.io/cocoapods/v/SKKeyboardResigner.svg?style=flat)](http://cocoapods.org/pods/SKKeyboardResigner)
[![License](https://img.shields.io/cocoapods/l/SKKeyboardResigner.svg?style=flat)](http://cocoapods.org/pods/SKKeyboardResigner)
[![Platform](https://img.shields.io/cocoapods/p/SKKeyboardResigner.svg?style=flat)](http://cocoapods.org/pods/SKKeyboardResigner)

## Description

With SKKeyboardResigner you can forget about resigning the keyboard by yourself by adding a big button inside a view or doing some 'ñapas' like that. This library takes care of resigning the keyboard for the view you want without doing nothing.

## Usage

There are two ways of using this library:

1.
Set your UITextFields inside a view container and set the View to subclass SKKeyboardResignerView

![alt text](https://github.com/skyweb07/SKKeyboardResigner/blob/master/Resources/subclass_sample.png?raw=true"Subclass sample")

2.
You can directly call the SKKeyboardResigner class methods in one of two ways:

```objective-c
[SKKeyboardResigner attachObserverToView:viewToObserve]; // If you only want to observe that View UITextFields subviews
```

or

```objective-c
[SKKeyboardResigner attachObserverToView:viewToObserve textFieldsToObserve:textField1, textField2, nil]; // If you want to observe any view and any UITextFields
```

To run the example project, clone the repo, and run `pod install` from the Example directory first.

## Installation

SKKeyboardResigner is available through [CocoaPods](http://cocoapods.org). To install
it, simply add the following line to your Podfile:

```ruby
pod "SKKeyboardResigner"
```

## Author

Oscar Duran, skyweb09@hotmail.es

## License

SKKeyboardResigner is available under the MIT license. See the LICENSE file for more info.


text:
import * as assert from 'assert';
import { StandardAutoClosingPairConditional } from 'vs/editor/common/modes/languageConfiguration';
import { StandardTokenType } from 'vs/editor/common/modes';

suite('StandardAutoClosingPairConditional', () => {

	test('Missing notIn', () => {
		let v = new StandardAutoClosingPairConditional({ open: '{', close: '}' });
		assert.equal(v.isOK(StandardTokenType.Other), true);
		assert.equal(v.isOK(StandardTokenType.Comment), true);
		assert.equal(v.isOK(StandardTokenType.String), true);
		assert.equal(v.isOK(StandardTokenType.RegEx), true);
	});

	test('Empty notIn', () => {
		let v = new StandardAutoClosingPairConditional({ open: '{', close: '}', notIn: [] });
		assert.equal(v.isOK(StandardTokenType.Other), true);
		assert.equal(v.isOK(StandardTokenType.Comment), true);
		assert.equal(v.isOK(StandardTokenType.String), true);
		assert.equal(v.isOK(StandardTokenType.RegEx), true);
	});

	test('Invalid notIn', () => {
		let v = new StandardAutoClosingPairConditional({ open: '{', close: '}', notIn: ['bla'] });
		assert.equal(v.isOK(StandardTokenType.Other), true);
		assert.equal(v.isOK(StandardTokenType.Comment), true);
		assert.equal(v.isOK(StandardTokenType.String), true);
		assert.equal(v.isOK(StandardTokenType.RegEx), true);
	});

	test('notIn in strings', () => {
		let v = new StandardAutoClosingPairConditional({ open: '{', close: '}', notIn: ['string'] });
		assert.equal(v.isOK(StandardTokenType.Other), true);
		assert.equal(v.isOK(StandardTokenType.Comment), true);
		assert.equal(v.isOK(StandardTokenType.String), false);
		assert.equal(v.isOK(StandardTokenType.RegEx), true);
	});

	test('notIn in comments', () => {
		let v = new StandardAutoClosingPairConditional({ open: '{', close: '}', notIn: ['comment'] });
		assert.equal(v.isOK(StandardTokenType.Other), true);
		assert.equal(v.isOK(StandardTokenType.Comment), false);
		assert.equal(v.isOK(StandardTokenType.String), true);
		assert.equal(v.isOK(StandardTokenType.RegEx), true);
	});

	test('notIn in regex', () => {
		let v = new StandardAutoClosingPairConditional({ open: '{', close: '}', notIn: ['regex'] });
		assert.equal(v.isOK(StandardTokenType.Other), true);
		assert.equal(v.isOK(StandardTokenType.Comment), true);
		assert.equal(v.isOK(StandardTokenType.String), true);
		assert.equal(v.isOK(StandardTokenType.RegEx), false);
	});

	test('notIn in strings nor comments', () => {
		let v = new StandardAutoClosingPairConditional({ open: '{', close: '}', notIn: ['string', 'comment'] });
		assert.equal(v.isOK(StandardTokenType.Other), true);
		assert.equal(v.isOK(StandardTokenType.Comment), false);
		assert.equal(v.isOK(StandardTokenType.String), false);
		assert.equal(v.isOK(StandardTokenType.RegEx), true);
	});

	test('notIn in strings nor regex', () => {
		let v = new StandardAutoClosingPairConditional({ open: '{', close: '}', notIn: ['string', 'regex'] });
		assert.equal(v.isOK(StandardTokenType.Other), true);
		assert.equal(v.isOK(StandardTokenType.Comment), true);
		assert.equal(v.isOK(StandardTokenType.String), false);
		assert.equal(v.isOK(StandardTokenType.RegEx), false);
	});

	test('notIn in comments nor regex', () => {
		let v = new StandardAutoClosingPairConditional({ open: '{', close: '}', notIn: ['comment', 'regex'] });
		assert.equal(v.isOK(StandardTokenType.Other), true);
		assert.equal(v.isOK(StandardTokenType.Comment), false);
		assert.equal(v.isOK(StandardTokenType.String), true);
		assert.equal(v.isOK(StandardTokenType.RegEx), false);
	});

	test('notIn in strings, comments nor regex', () => {
		let v = new StandardAutoClosingPairConditional({ open: '{', close: '}', notIn: ['string', 'comment', 'regex'] });
		assert.equal(v.isOK(StandardTokenType.Other), true);
		assert.equal(v.isOK(StandardTokenType.Comment), false);
		assert.equal(v.isOK(StandardTokenType.String), false);
		assert.equal(v.isOK(StandardTokenType.RegEx), false);
	});
});


text:
<?xml version="1.0" encoding="UTF-8"?>
<BulkOperationMetadata templateName="addSA_UsingSpecimenBarcode" batchSize="5">
	<BulkOperationClass className="edu.wustl.catissuecore.domain.SpecimenArray"       >

   <containmentAssociation className="edu.wustl.catissuecore.domain.Capacity"    roleName="capacity"   >
		<attribute name="oneDimensionCapacity" csvColumnName="Capacity_Dim_One"   />
		<attribute name="twoDimensionCapacity" csvColumnName="Capacity_Dim_Two"   />
    </containmentAssociation>

   <referenceAssociation className="edu.wustl.catissuecore.domain.SpecimenArrayType"       roleName="specimenArrayType">
	 	<attribute name="id" csvColumnName="Array Type"   />
   </referenceAssociation>

    <referenceAssociation className="edu.wustl.catissuecore.domain.SpecimenArrayContent"    maxNoOfRecords="4"  cardinality="*" roleName="specimenArrayContentCollection">
		<referenceAssociation className="edu.wustl.catissuecore.domain.Specimen"    maxNoOfRecords="1"   roleName="specimen">
		<!--<attribute name="label" csvColumnName="Specimen_Label"  	/>-->
		<attribute name="barcode" csvColumnName="Specimen_Barcode"   />
    	</referenceAssociation>
		<attribute name="positionDimensionOne" csvColumnName="Dim_One"   />
		<attribute name="positionDimensionTwo" csvColumnName="Dim_Two"   />
		<attribute name="concentrationInMicrogramPerMicroliter" csvColumnName="Concentration"   />
		<attribute name="initialQuantity" csvColumnName="Quantity"   />
	</referenceAssociation>

	<attribute name="name" csvColumnName="Array_Label"   />
	<attribute name="barcode" csvColumnName="Spec_Array_Barcode"   />
	<attribute name="comment" csvColumnName="Spec_Array_Comments"   />

	<referenceAssociation className="edu.wustl.catissuecore.domain.ContainerPosition"       roleName="locatedAtPosition">
		<attribute name="positionDimensionOne" csvColumnName="Storage_Position_Container_D1"   />
		<attribute name="positionDimensionTwo" csvColumnName="Storage_Position_Container_D2"   />
		<referenceAssociation className="edu.wustl.catissuecore.domain.Container"       roleName="parentContainer">
			<attribute name="id" csvColumnName="Storage_Position_Container_Id"   />
    	</referenceAssociation>
    </referenceAssociation>

    <referenceAssociation className="edu.wustl.catissuecore.domain.User"       roleName="createdBy">
        <attribute name="id" csvColumnName="Created By_User_ID"   />
    </referenceAssociation>

  </BulkOperationClass>
</BulkOperationMetadata>


text:
package com.nhaarman.sqlitebuilder.impl;

import com.nhaarman.sqlitebuilder.SqlPart;
import org.jetbrains.annotations.Nullable;

abstract class BaseSqlPart implements SqlPart {

  @Nullable
  @Override
  public Object[] getArguments() {
    return null;
  }
}


text:
namespace chromeos {

class UI_BASE_EXPORT MockIMEEngineHandler : public IMEEngineHandlerInterface {
 public:
  MockIMEEngineHandler();
  virtual ~MockIMEEngineHandler();

  virtual void FocusIn(const InputContext& input_context) OVERRIDE;
  virtual void FocusOut() OVERRIDE;
  virtual void Enable(const std::string& component_id) OVERRIDE;
  virtual void Disable() OVERRIDE;
  virtual void PropertyActivate(const std::string& property_name) OVERRIDE;
  virtual void Reset() OVERRIDE;
  virtual void ProcessKeyEvent(const ui::KeyEvent& key_event,
                               const KeyEventDoneCallback& callback) OVERRIDE;
  virtual void CandidateClicked(uint32 index) OVERRIDE;
  virtual void SetSurroundingText(const std::string& text, uint32 cursor_pos,
                                  uint32 anchor_pos) OVERRIDE;

  int focus_in_call_count() const { return focus_in_call_count_; }
  int focus_out_call_count() const { return focus_out_call_count_; }
  int reset_call_count() const { return reset_call_count_; }
  int set_surrounding_text_call_count() const {
    return set_surrounding_text_call_count_;
  }
  int process_key_event_call_count() const {
    return process_key_event_call_count_;
  }

  const InputContext& last_text_input_context() const {
    return last_text_input_context_;
  }

  std::string last_activated_property() const {
    return last_activated_property_;
  }

  std::string last_set_surrounding_text() const {
    return last_set_surrounding_text_;
  }

  uint32 last_set_surrounding_cursor_pos() const {
    return last_set_surrounding_cursor_pos_;
  }

  uint32 last_set_surrounding_anchor_pos() const {
    return last_set_surrounding_anchor_pos_;
  }

  const ui::KeyEvent* last_processed_key_event() const {
    return last_processed_key_event_.get();
  }

  const KeyEventDoneCallback& last_passed_callback() const {
    return last_passed_callback_;
  }

 private:
  int focus_in_call_count_;
  int focus_out_call_count_;
  int set_surrounding_text_call_count_;
  int process_key_event_call_count_;
  int reset_call_count_;
  InputContext last_text_input_context_;
  std::string last_activated_property_;
  std::string last_set_surrounding_text_;
  uint32 last_set_surrounding_cursor_pos_;
  uint32 last_set_surrounding_anchor_pos_;
  scoped_ptr<ui::KeyEvent> last_processed_key_event_;
  KeyEventDoneCallback last_passed_callback_;
};

}  // namespace chromeos

#endif  // UI_BASE_IME_CHROMEOS_MOCK_IME_ENGINE_HANDLER_H_


text:
module GitCompound
  describe Worker::NameConstraintChecker do
    let!(:components) { create_all_components! }
    let(:base_component_path) { base_component_path! }

    let(:component) do
      component_dir = base_component_path
      Component.new(:base_component) do
        branch 'master'
        source component_dir
        destination '/some/destinaton'
      end
    end

    context 'component and its manifest names matches' do
      it 'should not raise error' do
        expect { component.process(described_class.new) }
          .to_not raise_error
      end
    end

    context 'component and its manifest names differ' do
      before do
        git(components[:component_1].origin) do
          git_edit_file('.gitcompound') do
            <<-END
              name :component_1_invalid # <-- invalid name constraint

              component :leaf_component do
                version '1.0'
                source  '#{components[:leaf_component_1].origin}'
                destination '/leaf_component_1_destination'
              end
            END
          end
          git_commit('.gitcompound with invalid name of component 1')
          git_tag('v1.3', 'version 1.3')
        end
      end

      it 'should raise error when component and its manifest names differ' do
        expect { component.process(described_class.new) }
          .to raise_error NameConstraintError
      end
    end
  end
end


text:
/* ************************************************************************
************************************************************************ */
/**
 * This mixin is loaded by the admin.utils.LayoutDesigner and defines everything
 * required to be known for manipulating FieldArea layout entities.
 */
qx.Mixin.define("admin.utils.layout.FieldArea", {

	members: {

		/** This will create an xml node with our default values.
		 */
		createXmlNodeForFieldArea: function(xmlNodeParent)
		{
			var xmlNode = xmlNodeParent.ownerDocument.createElement( "FieldArea" );
			xmlNode.setAttribute( "first", "80" );
			xmlNode.setAttribute( "second", "80" );
			return xmlNode;
		},

		/** This will return a list of node names that can be children of our
		  * xml node in a valid layout.
		  */
		validChildrenForFieldArea: function()
		{
			return [
				"DoubleCheck2",
				"DoubleCheck",
				"DoubleField",
				"LongLabel",
				"QuadCheck",
				"RadioGroup2",
				"RadioGroup3",
				"RadioGroup4",
				"RadioGroup5",
				"SingleCheck",
				"SpanField"
			];
		},

		/** When this type of node is selected in the tree, this method will be
		 * called to tell the details editor how to lay itself out and how to map
		 * the xmlNode attriutes to the widgets on the settings pane.
		 */
		editDetailsForFieldArea: function(treeNode, xmlNode)
		{
			this.reRenderSettingsPane( "LayoutDesigner.FieldArea.xml" );
			this.pushXmlToFields( xmlNode, [
				"first", "second"
			] );
		},

		/** When the user invokes the context menu on one of our nodes, this
		 * is the menu that we will return.  Ensure that we only create the menu
		 * once, and then return it if it already exists.
		 */
		rmcMenuForFieldArea: function()
		{
			return null;
		},

		/** This will read the data out of the given XML node and convert it into a
		  * series of test settings that can be used in our automation component.
		  */
		testSettingsForFieldArea: function(xmlNode, testSettingsArray)
		{
			return;
		}

	}

});


text:
/*
 * To change this license header, choose License Headers in Project Properties.
 * To change this template file, choose Tools | Templates
 * and open the template in the editor.
 */
package counter.ejb;

import javax.ejb.Singleton;
import javax.ejb.Startup;

/**
 *
 * @author nolanof
 */
@Startup
@Singleton
public class CounterBean {

    private int hits = 1;

    // Increment and return the number of hits
    public int getHits() {
        return hits++;
    }
}


text:
- Added the Code42 File Download as a subplaybook to retrieve files using the Code42 integration.
- Fixed an issue that caused an error in the playbook when one of the subplaybooks was not available.

##### Get File Sample From Path - Generic V2
- Fixed an issue that caused an error in the playbook when one of the subplaybooks was not available.


text:
package main.scala.co.skaphe.multiplication.messages

case class Multiply(number: Int, times: Int)
case class Result(number: Int)


text:
package gobblin.policies.count;

import org.slf4j.Logger;
import org.slf4j.LoggerFactory;

import gobblin.configuration.ConfigurationKeys;
import gobblin.configuration.State;
import gobblin.qualitychecker.task.TaskLevelPolicy;

public class RowCountPolicy extends TaskLevelPolicy {
  private static final Logger LOG = LoggerFactory.getLogger(RowCountPolicy.class);
  private final long rowsRead;
  private final long rowsWritten;

  public RowCountPolicy(State state, TaskLevelPolicy.Type type) {
    super(state, type);
    this.rowsRead = state.getPropAsLong(ConfigurationKeys.EXTRACTOR_ROWS_EXPECTED);
    this.rowsWritten = state.getPropAsLong(ConfigurationKeys.WRITER_ROWS_WRITTEN);
  }

  @Override
  public Result executePolicy() {
    if (this.rowsRead == this.rowsWritten) {
      return Result.PASSED;
    }
    LOG.warn(this.getClass().getSimpleName() + " fails as read count and write count mismatch: " + this);
    return Result.FAILED;
  }

  @Override
  public String toString() {
    return String.format("RowCountPolicy [rowsRead=%s, rowsWritten=%s]", this.rowsRead, this.rowsWritten);
  }
}