module Main where
import Text.XHtml
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
-- The key here is inventing a ConcreteDataView for our data structure.
-- See OpenAFP.Types.View for details.
type Encodings = [String]
data Opts = Opts
{ encodings :: Encodings
, inputFile :: String
, openOutputHandle :: IO Handle
, verbose :: Bool
, showHelp :: IO ()
} deriving (Typeable)
defaultOpts :: Opts
defaultOpts = Opts
{ encodings = ["937", "500"]
, inputFile = requiredOpt usage "input"
, openOutputHandle = return stdout
, verbose = False
, showHelp = return ()
}
usage :: String -> IO a
usage = showUsage options showInfo
where
showInfo prg =
"Usage: " ++ prg ++ " [-e enc,enc...] input.afp > output.html\n" ++
"( example: " ++ prg ++ " -e 437,947 big5.afp > output.html)"
options :: [OptDescr (Opts -> Opts)]
options =
[ reqArg "e" ["encodings"] "ENC,ENC..." "Text encodings (default: 937,500)"
(\s o -> o { encodings = splitComma s })
, reqArg "i" ["input"] "FILE" "Input AFP file"
(\s o -> o { inputFile = s })
, reqArg "o" ["output"] "FILE" "Output HTML file"
(\s o -> o { openOutputHandle = openFile s WriteMode })
, noArg "h" ["help"] "Show help"
(\o -> o { showHelp = usage "" })
]
splitComma :: String -> [String]
splitComma "" = []
splitComma s = l : case s' of
[] -> []
(_:s'') -> splitComma s''
where
(l, s') = break (== ',') s
getOpts :: IO Opts
getOpts = do
args <- getArgs
(optsIO, rest, errs) <- return . getOpt Permute options $ procArgs args
return $ foldl (flip ($)) defaultOpts optsIO
where
procArgs xs
| null xs = ["-h"]
| even $ length xs = xs
| otherwise = init xs ++ ["-i", last xs]
run :: IO ()
run = withArgs (words "-e 937,500 -i ln-1.afp -o x.html") main
main :: IO ()
main = do
opts <- getOpts
let input = inputFile opts
cs <- readAFP input
fh <- openOutputHandle opts
writeIORef encsRef $ encodings opts
let put = hPutStr fh
put ""
put ""
put ""
put $ htmlPage input
put ""
mapM_ (hPutStrLn fh . (`withChunk` (showHtmlFragment . recHtml . recView))) cs
put "