Permalink
Browse files

* Various GHC7 fixes; afp-udcfix.hs still not yet ported to new excep…

…tion style...
  • Loading branch information...
audreyt committed Aug 29, 2011
1 parent 9fc9bf1 commit 0419a5cd6c30607befa5fb76b7afb499327b6f0c
Showing with 31 additions and 21 deletions.
  1. +14 −14 OpenAFP-Utils.cabal
  2. +14 −5 afp-dump.hs
  3. +1 −0 afp-replace.hs
  4. +2 −2 afp-validate.hs
View
@@ -8,64 +8,64 @@ Synopsis: Assorted utilities to work with AFP data streams
Description: Assorted utilities to work with AFP data streams
Category: Data
Build-type: Simple
-Cabal-Version: >= 1.2
+Cabal-Version: >= 1.2.3
Executable afp2line2pdf
Main-is: afp2line2pdf.hs
- Build-depends: OpenAFP >= 1.2, haskell98, base, line2pdf >= 0.0.7
+ Build-depends: OpenAFP >= 1.2, base, line2pdf >= 0.0.7
Extensions: StandaloneDeriving, GeneralizedNewtypeDeriving, ImplicitParams,
ExistentialQuantification, PatternGuards
Executable afp-olndump
Main-is: afp-olndump.hs
- Build-depends: OpenAFP >= 1.2, haskell98, base, bytestring, containers, binary
+ Build-depends: OpenAFP >= 1.2, base, bytestring, containers, binary
Executable afp-dump
Main-is: afp-dump.hs
- Build-depends: OpenAFP >= 1.2, haskell98, base, bytestring, containers, uconv, xhtml
+ Build-depends: OpenAFP >= 1.2, base, bytestring, containers, iconv, xhtml
Extensions: DeriveDataTypeable, PatternGuards
Executable afp-page
Main-is: afp-page.hs
- Build-depends: OpenAFP >= 1.2, haskell98, base
+ Build-depends: OpenAFP >= 1.2, base
Executable afp-replace
Main-is: afp-replace.hs
- Build-depends: OpenAFP >= 1.2, haskell98, base
+ Build-depends: OpenAFP >= 1.2, base
Extensions: DeriveDataTypeable, FlexibleContexts, PatternGuards
Executable afp-scanudc
Main-is: afp-scanudc.hs
- Build-depends: OpenAFP >= 1.2, haskell98, base>=3 && <4, directory
+ Build-depends: OpenAFP >= 1.2, base >= 4 && < 5, directory
Extensions: BangPatterns, PatternGuards
Executable afp-split
Main-is: afp-split.hs
- Build-depends: OpenAFP >= 1.2, haskell98, base
+ Build-depends: OpenAFP >= 1.2, base
Executable afp-split-scb
Main-is: afp-split-scb.hs
- Build-depends: OpenAFP >= 1.2, haskell98, base
+ Build-depends: OpenAFP >= 1.2, base
Executable afp-split-tcb
Main-is: afp-split-tcb.hs
- Build-depends: OpenAFP >= 1.2, haskell98, base, filepath
+ Build-depends: OpenAFP >= 1.2, base, filepath
Extensions: ImplicitParams
Executable afp-type
Main-is: afp-type.hs
- Build-depends: OpenAFP >= 1.2, haskell98, base
+ Build-depends: OpenAFP >= 1.2, base
Executable afp-udcfix
Main-is: afp-udcfix.hs
- Build-depends: OpenAFP >= 1.2, haskell98, base, regex-base, regex-posix
+ Build-depends: OpenAFP >= 1.2, base, regex-base, regex-posix
Extensions: DeriveDataTypeable, MultiParamTypeClasses, FlexibleContexts, PatternGuards, RankNTypes
Executable afp-validate
Main-is: afp-validate.hs
- Build-depends: OpenAFP >= 1.2, haskell98, base>=3 && <4
+ Build-depends: OpenAFP >= 1.2, base >= 4 && < 5
Executable afp2line
Main-is: afp2line.hs
- Build-depends: OpenAFP >= 1.2, haskell98, base
+ Build-depends: OpenAFP >= 1.2, base
Extensions: GeneralizedNewtypeDeriving
View
@@ -1,9 +1,10 @@
module Main where
import Text.XHtml
-import Codec.Text.UConv
+import Codec.Text.IConv
import OpenAFP hiding ((!))
import qualified Data.Set as Set
import qualified Data.ByteString as S
+import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString.Char8 as C
import qualified Data.HashTable as H
@@ -154,26 +155,34 @@ typeHtml' :: RecordType -> Html
typeHtml' t = thediv << (typeStr +++ primHtml " &mdash; " +++ typeDesc)
where
typeStr = bold << reverse (takeWhile (/= '.') (reverse typeRepr))
- typeDesc = stringToHtml $ descLookup (MkChunkType $ typeInt t)
+ typeDesc = stringToHtml $ descLookup (mkChunkType t)
typeRepr = show t
ptxHtml :: [N1] -> [Html]
ptxHtml nstr = [table << textHtml]
where
textHtml = textLine ++ [ nstrLine ]
- textLine = [ fieldHtml (ViewField (C.pack $ "(" ++ n ++ ")") (ViewString (typeOf ()) (C.pack txt))) | (n, txt) <- texts nstr ]
+ textLine = [ fieldHtml (ViewField (C.pack $ "(" ++ n ++ ")") (ViewString (typeOf ()) txt)) | (n, txt) <- texts nstr ]
nstrLine = tr << td ! [colspan 2] << thespan << nstrHtml nstr
+texts :: [N1] -> [(String, ByteString)]
texts nstr = maybeToList $ msum [ maybe Nothing (Just . ((,) cp)) $ conv (codeName cp) | cp <- encs ]
where
conv c@"ibm-937"
- | (even $ length nstr) = convert c "utf8" (packNStr $ toNStr (0x0E : nstr))
+ | (even $ length nstr) = convert' c "utf8" (packNStr $ toNStr (0x0E : nstr))
| otherwise = Nothing
- conv c = convert c "utf8" (packNStr $ toNStr nstr)
+ conv c = convert' c "utf8" (packNStr $ toNStr nstr)
codeName c
| isJust $ find (not . isDigit) c = c
| otherwise = "ibm-" ++ c
+convert' :: String -> String -> ByteString -> Maybe ByteString
+convert' from to str = case convertStrictly from to strLazy of
+ Left resLazy -> Just $ S.concat (L.toChunks resLazy)
+ _ -> Nothing
+ where
+ strLazy = L.fromChunks [str]
+
fieldsHtml :: [ViewField] -> [Html]
fieldsHtml fs = [table << fsHtml] ++ membersHtml
where
View
@@ -1,3 +1,4 @@
+{-# LANGUAGE DeriveDataTypeable, FlexibleContexts #-}
module Main where
import OpenAFP
import qualified Data.ByteString.Lazy as L
View
@@ -1,7 +1,7 @@
module Main where
import OpenAFP
import System.Exit
-import qualified Control.Exception as E (try, catch, throwIO)
+import qualified Control.Exception as E (try, catch, throwIO, SomeException)
main :: IO ()
main = do
@@ -26,7 +26,7 @@ main = do
case rv of
Right ok -> return ok
Left err -> do
- print err
+ print (err :: E.SomeException)
return False
if and oks
then exitWith ExitSuccess

0 comments on commit 0419a5c

Please sign in to comment.