[PrettyPrinting for Logging
martin.hofmann@uni-bamberg.de**20090123084353] hunk ./src/Data/CallDependencies.hs 22
+import Logging
hunk ./src/Data/HypoSpace.hs 224
-    show hsp = showString "HSpace {\n\trateIDsMap =" .
-               shows (rateIdsMap hsp) .
-               showString "\n\truleIdsMap =" .
-               showAsSet (M.toList (ruleIdsMap hsp)) .
-               showString "\n\tidRateMap =" .
-               showAsSet (B.toList (hypoIdBimap hsp)) $
-               "\n}"
-
-
+	show = show.pretty            
+instance Pretty HSpace where
+	pretty hsp = text "HSpace" <$> parens (
+				 indent 2 $ 
+				 text "Rating -> HypoID:" <$> pretty (rateIdsMap hsp) <$> 
+				 text "Rating -> HypoID:" <$> pretty (ruleIdsMap hsp) <$> 
+				 text "ID -> Hypo: <ommitted>" -- <$> pretty (hypoIdBimap hsp)
+				 )        
+   
hunk ./src/Data/Hypotheses.hs 39
+import Logging
hunk ./src/Data/Hypotheses.hs 63
-    show (HH o c cs) = showString "Hypo(\n\topen:" .
-                    shows o .
-                    showString "\n\tclosed:" .
-                    shows c $
-                    showString "\n\tcallings:" .
-                    shows cs $
-                    ")"
+    show = show.pretty
+                    
+instance Pretty Hypo where
+	pretty (HH o c cs) = text "Hypo" <>  parens (
+						 align $ --indent 2 $
+						 text "open:" <+> pretty o <$> 
+						 text "closed:" <+> pretty c <$> 
+						 text "callings:" <+> pretty cs)
+						 
hunk ./src/Data/Hypotheses.hs 147
-    show hs = (showAsSet $ S.toList.unHHs $ hs) ""    
+    show  = show.pretty
+instance Pretty Hypos where
+	pretty (HHs s) = pretty s    
hunk ./src/Data/IgorMonad.hs 35
-    put $ setupTarget igor n
+    let igor' = setupTarget igor n
+    llogIN $ text "Target set, IGOR initialised to:"
+    llogIN $ indent 2 (pretty igor')
+    put igor'
hunk ./src/Data/IgorMonad.hs 60
-    { iodata :: !IOData, searchSpace :: !HSpace}
+    { iodata :: !IOData, searchSpace :: !HSpace, loopcount :: [(Name,Int)]}
+    deriving (Show)
+    
+instance Pretty Igor where
+	pretty = text.show
hunk ./src/Data/Rules.hs 105
-    
+
+instance Pretty Rule where
+	pretty = text.show    
hunk ./src/Data/Rules.hs 120
-    show rs = showAsSet (rulesToList rs) $ ""
+    show = show.pretty
+    
+instance Pretty Rules where
+	pretty (RS s) = pretty s
hunk ./src/Logging.hs 4
-       module Logging.Logger,
-       module Logging.PrettyPrinter
+       module Logging.Logger
hunk ./src/Logging.hs 9
-import Logging.PrettyPrinter
hunk ./src/Logging/Logger.hs 3
---(
---    
---    runELT,  runEL,
---    Log, Logger, Message, Priority,
---    LM, 
---    logDE,logIN,logNO,logWA,logER,logCR,logAL,logEM,
---    llogDE,llogIN,llogNO,llogWA,llogER,llogCR,llogAL,llogEM
---    pnd, skip,
---    
---    module Control.Monad , 
---    module Control.Monad.Writer , 
---    module Control.Monad.State,
---    module Control.Monad.Trans,
---    module Language.Haskell.TH
---    ) 
+(
+    
+    runELT,  runEL, noLog,
+    Log, Logger, Message, Priority(..),
+    LM, 
+    logDE,logIN,logNO,logWA,logER,logCR,logAL,logEM,
+    llogDE,llogIN,llogNO,llogWA,llogER,llogCR,llogAL,llogEM,
+    llogEnterDE, llogEnterIN,
+    setCurrentLogger, setGlobalLogLevel,
+    getCurrentLogger, getGlobalLogLevel,
+    setPriority, getPriority,
+    
+    (<^>), ($$), patternNotDef,
+    
+    module Control.Monad , 
+    module Control.Monad.Writer , 
+    module Control.Monad.State,
+    module Control.Monad.Trans,
+    --module Language.Haskell.TH,
+    module Text.PrettyPrint.ANSI.Leijen,
+    module Debug.Trace
+    ) 
hunk ./src/Logging/Logger.hs 27
-import Logging.PrettyPrinter
+-- import Logging.PrettyPrinter
hunk ./src/Logging/Logger.hs 29
-import Data.List (isPrefixOf, intersperse)
+import Data.List (isPrefixOf, intersperse, foldl')
+import qualified Data.Map as M
+import qualified Data.Set as S
+import qualified Data.IntMap as IM
+import qualified Data.IntSet as IS
hunk ./src/Logging/Logger.hs 41
+import Language.Haskell.TH
hunk ./src/Logging/Logger.hs 43
+import Debug.Trace
+
+import Text.PrettyPrint.ANSI.Leijen
hunk ./src/Logging/Logger.hs 58
-type Message  = [String]
-type LogEntry = (Priority,Logger,Message)
+type Message  = Doc
+data LogEntry = LE Priority Logger Message 
+
+instance Pretty LogEntry where
+	pretty (LE p l m) = (text (show p)) <+> text l <+> ( text ":" $$ m)
+	prettyList l   =  foldl' (flip ((<$>).pretty)) empty	 l
hunk ./src/Logging/Logger.hs 66
-mergeEntries (p1,l1,m1) (p2,l2,m2)
-    | p1 == p2 && l1 == l2 = [(p1,l1,(m1++m2))]
-    | otherwise            = [(p1,l1,m1),(p2,l2,m2)]
+mergeEntries (LE p1 l1 m1) (LE p2 l2 m2)
+    | p1 == p2 && l1 == l2 = [LE p1 l1 (m1 <$$> m2)]
+    | otherwise            = [(LE p1 l1 m1),(LE p2 l2 m2)]
hunk ./src/Logging/Logger.hs 70
---                        GlobalLogger, CurrentLogger
-type LogState = (Priority,Logger,Logger)
hunk ./src/Logging/Logger.hs 71
-showLogEntry :: LogEntry -> String
-showLogEntry (p,l,m) = shows p 
-                     . showString (replicate (9 - length (show p)) ' ') 
-                     . showString " -> " 
-                     . showString l 
-                     . showString ":\n\n\t" 
-                     . showString (concat (intersperse "\n\t" m)) 
-                     $ "\n\n"
+type LogState = (Priority  -- ^Priority
+				,Logger    -- ^Global Logger
+				,Logger)   -- ^Current Logger
hunk ./src/Logging/Logger.hs 75
-    
-data Log = Log  {logs :: [LogEntry], lst :: Maybe LogEntry}
hunk ./src/Logging/Logger.hs 76
-instance Show Log where
-    show l = showString "\n" 
-           . showString (concatMap showLogEntry (logs l)) 
-           . showString (concatMap showLogEntry (maybeToList(lst l)))
-           $ "\n"
-    
+data Log = Log  {logs :: ![LogEntry], lst :: Maybe LogEntry}
+
hunk ./src/Logging/Logger.hs 79
-    pretty l = map showLogEntry (logs l) ++
-               map showLogEntry (maybeToList(lst l))
+    pretty l = (prettyList (logs l)) <$$> (prettyList (maybeToList (lst l)))
+    
+--instance Pretty Log where
+--    pretty l = map showLogEntry (logs l) ++
+--               map showLogEntry (maybeToList(lst l))
hunk ./src/Logging/Logger.hs 124
-logEnterDE = logDE [" - - - - - - Function entered - - - - - - "]
-logEnterIN = logIN [" - - - - - - Function entered - - - - - - "]
+logEnterDE = logDE $ text "\n - - - - - - Function entered - - - - - - "
+logEnterIN = logIN $ text "\n - - - - - - Function entered - - - - - - "
hunk ./src/Logging/Logger.hs 128
-logEntered p = logging p [" - - - - - - Function entered - - - - - - "]
+logEntered p = logging p $ text "\n - - - - - - Function entered - - - - - - "
hunk ./src/Logging/Logger.hs 152
-logging p msg   = getCurrentLogger >>= \l ->
-                  handle (p,l,msg)
+logging p msg   = traceIfDebug msg $ 
+                  getCurrentLogger >>= \l ->
+                  handle $ LE  p l msg
hunk ./src/Logging/Logger.hs 157
-noLog = fst.runEL            
+noLog = fst.runEL 
+
+_DEBUG = False
+
+traceIfDebug msg  = if _DEBUG then trace (show msg) else id          
hunk ./src/Logging/Logger.hs 171
---noLog :: (Elog m) => m a -> a
---noLog =  
-
-
hunk ./src/Logging/Logger.hs 172
-handle (p,l,msg) =
+handle (LE p l msg) =
hunk ./src/Logging/Logger.hs 175
-       when ((isPrefixOf gll l) && (lvl <= p)) $ tell (Log [] (Just (p,l,msg)))
+       when ((isPrefixOf gll l) && (lvl <= p)) $ tell (Log [] (Just (LE p l msg)))
hunk ./src/Logging/Logger.hs 178
-pnd :: [String] -> [String]
-pnd as = "Pattern not defined !!!":
-         [ "arg" ++ show (i+1) ++ " " ++ (as !! i) | i <- [0 .. (length as)-1]]
hunk ./src/Logging/Logger.hs 179
-skip :: String -> String
-skip = ("  " ++)
+--indent :: Message -> Message
+--indent m = map ("  "++) m
+--
+--indentN :: Int -> Message -> Message
+--indentN i m = map ((replicate i ' ')++) m
hunk ./src/Logging/Logger.hs 185
+--------------------------------------------------------------------------------
+-- Pretty Helpers
+--------------------------------------------------------------------------------
+
+x $$ y = align (x <$> y)
+x <^> y = x <$> ( indent 2 y)
+
+  
+set  l = braces $ align $ hcat $ punctuate comma l
+
+asMap (a,b) = 
+	lparen <> (pretty a) <+> ((text "->" ) <+> ( align (pretty b) <> rparen))
+	
+asRepl (a,b) = 
+	lparen <> (pretty a) <+> ((text "<~" ) <+> ( align (pretty b) <> rparen))
+
+
+
+patternNotDef :: [Doc] -> Doc
+patternNotDef as = text "Pattern not defined !!!" <$>
+				   vsep [ text "arg" <> int (i+1) <+> (as !! i) | i <- [0 .. (length as)-1]]
+
+
+--------------------------------------------------------------------------------
+-- Pretty Instances
+--------------------------------------------------------------------------------
+
+instance Pretty Exp where
+    pretty = text.pprint
+    
+instance Pretty Pat where
+    pretty = text.pprint
+      
+instance Pretty Dec where
+    pretty = text.pprint
+    
+instance Pretty Name where
+    pretty = text.show
hunk ./src/Logging/Logger.hs 224
+instance (Pretty k, Pretty v) => Pretty (M.Map k v) where
+	pretty m = list $ map asMap (M.toList m)
+	
+instance (Pretty v) => Pretty (IM.IntMap v) where
+	pretty m = list $ map asMap (IM.toList m)
hunk ./src/Logging/Logger.hs 230
+instance (Pretty e) => Pretty (S.Set e) where
+	pretty s = semiBraces $ map pretty (S.toList s)
+	
+instance Pretty (IS.IntSet) where
+	pretty s = set $ map pretty (IS.toList s)
hunk ./src/Logging/PrettyPrinter.hs 2
-module Logging.PrettyPrinter (
-    Pretty(..),
-    viewlist
-    ) where
+module Logging.PrettyPrinter  where
hunk ./src/Logging/PrettyPrinter.hs 6
+import Text.PrettyPrint.ANSI.Leijen
+
hunk ./src/Logging/PrettyPrinter.hs 9
-class (Show p) => Pretty p where
hunk ./src/Logging/PrettyPrinter.hs 10
-    view :: p -> String
-    view = concat.pretty
-    
-    pretty :: p -> [String]
hunk ./src/Logging/PrettyPrinter.hs 11
-instance Pretty Exp where
-    pretty = (:[]).pprint
-    
-instance Pretty Pat where
-    pretty = (:[]).pprint
-      
-instance Pretty Dec where
-    pretty = (:[]).pprint
hunk ./src/Logging/PrettyPrinter.hs 12
-instance Pretty Char where
-    pretty = (:[]).show
-    
-instance Pretty String where
-    pretty = (:[]).show
+
hunk ./src/Logging/PrettyPrinter.hs 16
-
-viewlist :: (Pretty e) => [e] -> String
-viewlist = concatMap view
+--
+--viewlist :: (Pretty e) => [e] -> String
+--viewlist = concatMap view
hunk ./src/SynthesisEngine.hs 35
-       let (r,l) = runEL  (synthesise tgt bgk)
-       runIO $ putStrLn "*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*"
-       runIO $ putStrLn "|                                 Logging Result                                |"
-       runIO $ putStrLn "*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*"
-       runIO $ putStrLn (view l)
-       runIO $ putStrLn "*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*"
-       runIO $ putStrLn "|                              Computational Result                             |"
-       runIO $ putStrLn "*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*"
-       runIO $ (printQ.return) r 
+       let (r,l) = runEL  (synthesise tgt bgk) 
+       runIO $ printLogFile (show (pretty l))
+--       runIO $ putStrLn "*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*"
+--       runIO $ putStrLn "|                                 Logging Result                                |"
+--       runIO $ putStrLn "*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*"
+--       runIO $ putDoc (pretty l)
+--       runIO $ putStrLn "*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*"
+--       runIO $ putStrLn "|                              Computational Result                             |"
+--       runIO $ putStrLn "*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*"
+       runIO $ mapM_ (printQ.return) r
hunk ./src/SynthesisEngine.hs 62
-synthesiseTarget :: Name -> IM [(Name,Rules)]
-synthesiseTarget n =  setTarget n >> currentBestHypos >>= closeHypos
+synthesiseTarget :: Name -> IM [[(Name,Rules)]]
+synthesiseTarget n =  do
+    llogEnterIN
+    llogNO $ text "STARTING SYNTHESIS for TARGET" <+> squotes (pretty n)
+    
+    setTarget n >> currentBestHypos >>= closeHypos
+
+closeHypos :: Hypos -> IM [[(Name,Rules)]]
+closeHypos hs =  do
hunk ./src/SynthesisEngine.hs 72
-closeHypos :: Hypos -> IM [(Name,Rules)]
-closeHypos hs =  do  
-    let openrules = foldHs collect emptyFs hs
-    if nullFs openrules
+    llogEnterIN
+    loopCount >>= \lc -> llogNO $ text "Entering Rule-Advancement-Loop for the" <+> int lc <+> text ". time"
+    llogIN $ text "Closing Hypos:" <^> pretty hs
+    hypoCount >>= \hc -> llogNO $ text "Currently are" <+> int hc <+> text "hypotheses in the search space"
+    getSearchSpace >>= \sp -> llogIN $ text "Current SearchSpace:" <^> pretty sp
+   
+    tick
+    let openrules = (foldHs collect S.empty hs) 
+    if S.null openrules
hunk ./src/SynthesisEngine.hs 87
-stopWith  :: Hypos -> IM [(Name,Rules)]
-stopWith hs = return $ M.toList.clsd.chooseOneHypo $ hyposToList hs
-    where
-    chooseOneHypo = head
+stopWith  :: Hypos -> IM [[(Name,Rules)]]
+stopWith hs = do 
+       llogIN $ text "STOP_WITH:" <^> pretty hs
+       return $ map (M.toList.clsd) (hyposToList hs)
hunk ./src/SynthesisEngine.hs 92
-advanceRule :: RuleFrag -> IM ()
-advanceRule rf = do
-    (rf,rfs) <- trivialPartition rf
-    modify $ propagate $ (rf,rfs,[])
-    return ()
+applyAdvacements :: RuleFrag -> IM ()
+applyAdvacements rf = do
+    advancements <- advanceRule rf
+    llogIN $ text "Advancing" <+> pretty rf 
+    llogIN $ text "Resulted in" <+> int (length advancements) <+> text "different sucessor hypotheses."
+    modify $ advancements `seq` (propagate rf advancements)
hunk ./src/Terms/Antiunifier.hs 361
-        llogDE ["Input arguments are :", viewlist l] >>
+        llogDE (text "Input arguments are :" <> pretty l) >>
hunk ./src/Terms/Antiunifier.hs 364
-                llogDE ["Subterms are :", concatMap viewlist subterms] 
+                llogDE (text "Subterms are :" <> pretty subterms) 
hunk ./src/Terms/Antiunifier.hs 374
-                llogDE ["Antinunified subterms (straight) are :", viewlist straightai] 
+                llogDE (text "Antinunified subterms (straight) are :" <> pretty straightai) 
hunk ./src/Terms/Antiunifier.hs 379
-                          llogDE ["List have different length"]
-                          llogDE ["Antinunified subterms (ragged) are :", viewlist straightai]
+                          llogDE $ text "List have different length"
+                          llogDE $ text "Antinunified subterms (ragged) are :" <> pretty straightai
hunk ./src/Terms/Antiunifier.hs 577
-checkforAntiInstance :: (Ord k, Eq t, Antiunifieable k v t) => [t] -> AU k v t
+checkforAntiInstance :: (Ord k, Pretty t, Antiunifieable k v t) => [t] -> AU k v t
hunk ./src/Terms/Antiunifier.hs 594
-    llogDE ["Term Image is:", show l]
+    llogDE $ text "Term Image is:" <> pretty l
hunk ./src/Terms/Antiunifier.hs 596
-    llogDE ["Current varTable is:", show table]
+    llogDE $ text "Current varTable is:" <> pretty table
hunk ./src/Terms/Antiunifier.hs 598
-    llogDE ["update varTable with var:", show var]
-    llogDE ["Updated varTable is:", show newTable]
+    llogDE $ text "update varTable with var:" <> pretty var
+    llogDE $ text "Updated varTable is:" <> pretty newTable
hunk ./src/Terms/Class.hs 33
-import Debug.Trace
+import Logging
hunk ./src/Terms/Class.hs 47
+instance Pretty Position where
+	pretty = text.show
hunk ./src/Terms/Class.hs 128
-class (Eq t, Show t, Ppr t) => Term t where
+class (Eq t, Show t, Pretty t) => Term t where
hunk ./src/Terms/Unifier.hs 25
-instance (Pretty a) => Pretty (Replacement a) where
-    pretty (e1,e2) = ["(" ++ (view e1) ++ " <~ " ++ (view e2) ++ ")"]
+--instance (Pretty a) => Pretty (Replacement a) where
+--    pretty (e1,e2) = parens $ (pretty e1) <+> (text " <~ ") <+> (pretty e2)
+--    prettyList s = brackets $ hsep $ map pretty s
hunk ./src/Terms/Unifier.hs 30
-instance (Pretty a) => Pretty (Substitution a) where
-    pretty s = map view s
hunk ./src/Terms/Unifier.hs 51
-              logDE ["Unifying terms:",skip (view x),skip (view y)] >> 
+              logDE (text "Unifying terms:" <+> pretty x <+> pretty y) >> 
hunk ./src/Terms/Unifier.hs 76
-                llogDE ["Found (Var <~ Val) in current unifier:"
-                        ,skip (view var) ++ " <~ " ++ (view val)
-                        ,skip "but need to match:"
-                        ,skip (view var) ++ " <~ " ++ (view t)] >>
-                flush >> fail "No Match!"
+                llogDE ( text "Found (Var <~ Val) in current unifier:" <^>
+                		 pretty var <+> text " <~ " <+> pretty val <$>
+                		 text "but need to match:" <^>
+                		 pretty var <+> text " <~ " <+> pretty t
+					   )
+				>> flush >> fail "No Match!"
hunk ./src/Terms/Unifier.hs 91
-           llogDE ["Var is:"
-                  ,skip $ view var
-                  ,"X is:"
-                  ,skip $ view x
-                  ,"Current unifier is:"
-                  ,skip $ view unifier]     
+           llogDE ( text "Var is:" <^> (pretty var) <$>
+					text "X is:" <^> (pretty x) <$>
+					text "Current unifier is:" <^> pretty unifier
+				  ) 
hunk ./src/Terms/Unifier.hs 97
-                llogDE ["Found (Var <~ Val) in current unifier:"
-                                            ,skip (view var) ++ " <~ " ++ (view val)
-                                            ,skip "continue unify val x"] >>
+                llogDE ( text "Found (Var <~ Val) in current unifier:" <$>
+                		 indent 2 (pretty var) <+> text " <~ " <+> pretty val <$>
+                		 indent 2 (text "continue unify val x")
+                		) >>
hunk ./src/Terms/Unifier.hs 104
-                                llogDE ["Found (X <~ Val) in current unifier:"
-                                                            ,skip (view x) ++ " <~ " ++ (view val)
-                                                            ,skip "continue unify var val"] >>
+                                llogDE ( text "Found (X <~ Val) in current unifier:" <^>
+                                		 (pretty x) <+> text "<~" <+> pretty val <^>
+                                		 text "continue unify var val"
+                                        ) >>
hunk ./src/Terms/Unifier.hs 111
-                                            else do llogDE ["Apply (Var <~ X) to current Unifier and Insert:"
-                                                                                ,skip (view var) ++ " <~ " ++ (view x)] 
+                                            else do llogDE ( text "Apply (Var <~ X) to current Unifier and Insert:" <^>
+                                            				 pretty var <+> text "<~" <+> pretty x
+                                            			   ) 
hunk ./src/Terms/Unifier.hs 136
-        let msg =  pnd [view u, view t]
+        let msg =  patternNotDef [pretty u, pretty t]
hunk ./src/Terms/Unifier.hs 138
-           logWA msg >> fail (concat msg)
+           logWA msg >> fail (show msg)
hunk ./src/Terms/Unifier.hs 182
-        let msg =  pnd [view s, view t]
+        let msg =  patternNotDef [pretty s, pretty t]
hunk ./src/Terms/Unifier.hs 184
-           llogWA msg >> llogDE (map show (unfoldAppE t)) >>
-           fail (concat msg)
+           llogWA msg >> llogDE (hsep (map pretty (unfoldAppE t))) >>
+           fail (show msg)
hunk ./src/Terms/Unifier.hs 229
-        let msg =  pnd [view s, view t]
+        let msg =  patternNotDef [pretty s, pretty t]
hunk ./src/Terms/Unifier.hs 231
-           llogWA msg >> llogDE (map show (unfoldAppE t)) >>
-           fail (concat msg)
+           llogWA msg >> llogDE (hsep (map pretty (unfoldAppE t))) >>
+           fail ( show msg)
hunk ./src/Terms/Unifier.hs 254
-        let msg =  pnd [view u, view t]
+        let msg =  patternNotDef [ pretty u, pretty t]
hunk ./src/Terms/Unifier.hs 256
-            logWA msg >> fail (concat msg) 
+            logWA msg >> fail ( show msg) 