这是我关于stackoverflow的第一篇文章，所以请耐心等待。
首先，我对Haskell一无所知;我用PHP（+ HTML / CSS）作为业余爱好编程。
我的一个朋友制作了一个解析器，用于在Haskell中将freedb文本文件解析为MySQL。他为Windows做了这个，但现在我想将源代码编译为Linux Mint 18.3 64bit上的Linux可执行文件。我的朋友在生病之前给了我一个源代码编辑器，将它调整到Linux并从Windows改变了Posix
System.FilePath.Posix (addTrailingPathSeparator,splitFileName,splitPath,takeDirectory)
这个源代码在Linux上编译得很好，我得到了一个可用的可执行文件，但是当我尝试运行它时出现了问题 - 出现了这个错误：
FreeDb：。\ data / getDirectoryContents：不存在（没有这样的文件或 目录）
它应该在启动可执行文件的目录中找到一个数据目录，但很明显。\ data /不能在linux上工作。
完整来源：
{-# LANGUAGE OverloadedStrings #-}
module Main where
import HulpFunc
import qualified Data.ByteString.Char8 as B
import Text.Parsec.ByteString
import Text.Parsec
import Data.Int
import Data.List
import Control.Applicative((*>),(<*))
import Text.Parsec.Prim((<|>))
import Data.String.Utils (strip)
import Data.Char
import System.FilePath.Posix (addTrailingPathSeparator,splitFileName,splitPath,takeDirectory)
import Control.Monad (filterM,liftM)
import System.Directory (getDirectoryContents,doesFileExist,doesDirectoryExist)
import System.IO (IOMode(..),hClose,hPrint,hSetEncoding,openFile,latin1,hSetBuffering,BufferMode,hPutStrLn,hGetContents)
import System.Environment
import Data.Time
import Control.Concurrent
import Control.Concurrent.Chan
import Control.Monad
import qualified Control.Concurrent.ThreadManager as TM
import System.Exit (exitFailure)
data Track = Track {
t_idx :: !Int,
t_title:: !B.ByteString,
t_artist:: !B.ByteString,
t_offset :: !Int,
t_lengthSec :: !Int -- lengte < 0 => onbekend
} deriving Show
data CD = CD {
d_id :: !B.ByteString,
d_title :: !B.ByteString,
d_artist :: !B.ByteString,
d_genre :: !B.ByteString,
d_year :: !Int,
d_lengthSec :: !Int,
d_tracks :: ![Track]
} deriving Show
emptyCD :: CD
emptyCD = CD {
d_id = "",
d_title = "",
d_artist = "",
d_genre = "",
d_year = 0,
d_tracks = [],
d_lengthSec = 0
}
freeDbFiles :: String -> IO [String]
freeDbFiles startDir = do
let startDir' = addTrailingPathSeparator startDir
names <- getDirectoryContents startDir'
let names' = Prelude.filter (`notElem` [".", ".."]) names
qualifiedNames = map (startDir' ++) names'
dirs <- filterM (doesDirectoryExist . addTrailingPathSeparator) qualifiedNames
files <- filterM doesFileExist qualifiedNames
subDirFiles <- mapM freeDbFiles dirs
return $ files ++ (concat subDirFiles)
insertCmd :: B.ByteString
insertCmd = "INSERT INTO `CDs`\n(`discId`,`genre`,`artiest`,`titel`,`jaar`,`lengte`,`nummers`)\nVALUES\n";
tracksToSQL :: [Track] -> B.ByteString
tracksToSQL tracks = surround "\'" $ foldr (\track str ->
let fieldValueList = map (\f -> (sqlEscape . f) track) [t_artist, t_title, B.pack . show . t_lengthSec] --list of Bytestrings
newStr = B.intercalate "@" fieldValueList
in newStr `B.append` "\n" `B.append` str ) "" tracks
showCD :: CD -> B.ByteString
showCD cd = let sqlTracks = tracksToSQL (d_tracks cd)
cdPart = (B.intercalate ", " $ map (\f -> (sqlField . f) cd)[d_id, d_genre, d_artist, d_title, B.pack . show . d_year, B.pack . show . d_lengthSec])
in zetHaakjes (cdPart `B.append` ",\n" `B.append` sqlTracks)
mySpace = (char ' ') <|> tab -- satisfy (\c -> (c == ' ' || c == '\t'))
mySpaces = many mySpace
-- alle parsers voor # (commentlines)
parseToNewLine :: GenParser Char CD B.ByteString
parseToNewLine = do
line <- manyTill anyChar eol
return $ "parseToNewLine: " `B.append` (B.pack line)
commentLine = do
char '#'
mySpaces
line <- (try trackFrameOffsets <|> try discLength <|> parseToNewLine)
return line
discLength :: GenParser Char CD B.ByteString
discLength = do
string "Disc length:"
mySpaces
str <- many digit
-- soms staat hier seconds soms niks
parseToNewLine
updateState (\cd -> cd{d_lengthSec = (read str::Int)})
return $ "DiscLength: " `B.append` (B.pack str)
readTrackOffSet= do
char '#'
mySpaces
str <- many1 digit
mySpaces
eol
return (read str::Int)
trackFrameOffsets = do
string "Track frame offsets:"
mySpaces
eol
offSets <- many (try readTrackOffSet)
cd <- getState
let tracks = map (\(idx,offSet) -> Track { t_idx = idx
,t_title=""
,t_artist=""
,t_offset=offSet
,t_lengthSec = 0
}) (zip [0..] offSets)
cd' = cd {d_tracks= tracks}
updateState (\cd -> cd')
return $ B.pack $ "Tracks: " ++ (show $ length offSets)
-- einde # (comment) parsers
eol = do
try (string "\n\r")
<|> try (string "\r\n")
<|> string "\n"
<|> string "\r"
play p s = runParser p emptyCD "parameter" $ B.pack s -- testen van een parser
playFile p fn = do
putStrLn fn
hIn <- openFile fn ReadMode
hSetEncoding hIn latin1
cont <- B.hGetContents hIn
B.putStrLn $ B.take 20 cont
cont `seq` hClose hIn
let res = play p $ B.unpack cont
res `seq` (putStrLn $ show res)
testCalcTrackLength =let cd = CD {d_id = "0c002502", d_title = "Well Well Well", d_artist = "Well Well Well", d_genre = "", d_year = 0, d_tracks = [Track {t_idx = 1, t_title = "Well Well Well2", t_artist = "", t_offset = 150, t_lengthSec = 0},Track {t_idx = 2, t_title = "", t_artist = "", t_offset = 1487, t_lengthSec = 0}], d_lengthSec = 39}
sortedTracks = sortBy (\tr1 tr2 -> compOffsets tr1 tr2) (d_tracks cd) -- omgekeerde volgorde
combinedTracks = zip sortedTracks (tail sortedTracks)
tracksWithLengthNoLastTrack = map (\(tHi,tLo) -> tLo {t_lengthSec = ((t_offset tHi) - (t_offset tLo)) `div` 75}) combinedTracks
lt = head sortedTracks
lt' = lt {t_lengthSec = (75 * (d_lengthSec cd) - (t_offset lt)) `div` 75}
tracksWithLength = lt' : tracksWithLengthNoLastTrack
cd' = calculateTrackLengths cd
in (show tracksWithLength) ++ "\r" ++ (show (tracksToSQL tracksWithLength))
-- begin keyValue parsers (zonder # aan het begin van de regel)
readIs = do
mySpaces
char '='
mySpaces
return ""
noHash = notFollowedBy (char '#')
updateTrackInfo :: Int -> B.ByteString -> B.ByteString -> [Track] -> [Track]
updateTrackInfo idx artist title tracks = map (\t -> if (t_idx t == idx) then
t { t_title=title,t_artist=artist}
else
t
) tracks
trackTitle :: GenParser Char CD B.ByteString
trackTitle = do -- dit is alleen voor tracks
string "TTITLE"
idxStr <- many1 digit
readIs
(fi,la)<- splitLine
let idx = read idxStr :: Int
(art,ti)= if (la == "") then -- alleen een titel, de artiest komt van de D_TITLE
("",fi)
else
(fi,la) -- een regel als "de artiest / de titel\n"
updateState (\cd -> cd {d_tracks = updateTrackInfo idx art ti (d_tracks cd)})
return ("TrackIdx: " `B.append` ((B.pack . show) idx) `B.append` ", Art: " `B.append` art `B.append` ", Titel: " `B.append` ti)
-- splits line in left,right by ' / '. Als er geen zit dan alles in left
charNotEol :: GenParser Char CD Char
charNotEol = do
c <- notFollowedBy eol *> anyChar
return c
splittableLine :: GenParser Char CD (B.ByteString,B.ByteString)
splittableLine = do
le <- manyTill charNotEol (try (string " / "))
ri <- restLine
return (B.pack le, ri)
noSplittableLine :: GenParser Char CD (B.ByteString,B.ByteString)
noSplittableLine = do
s <- restLine
return (s,"")
splitLine :: GenParser Char CD (B.ByteString,B.ByteString)
splitLine = (try splittableLine) <|> noSplittableLine
restEXTD = do -- extended value voor een disk. Meer EXTDs worden als strings aan elkaar geplakt.
char 'D'
readIs
extd <- restLine
return extd
restEXTTN = do
char 'T';
str <- many digit
let idx = read str :: Int
readIs
value <- restLine
return value
restLine = do
mySpaces
rest <- (manyTill anyChar eol)
return $ B.pack rest
restDTitle :: GenParser Char CD B.ByteString
restDTitle = do
string "TITLE"
readIs
(art,ti) <- splitLine
updateState( \cd -> cd{d_artist=art,d_title= ti})
return $ "DTitle: " `B.append` ti `B.append` ", DArtist: " `B.append` art
restDYear :: GenParser Char CD B.ByteString
restDYear = do
string "YEAR"
readIs
yearStr <- restLine
let y = if (trim yearStr == "") then
0
else
((read.B.unpack) yearStr)::Int
updateState( \cd -> cd{d_year=y})
return $ "DYEAR: " `B.append` yearStr
restDGenre :: GenParser Char CD B.ByteString
restDGenre= do
string "GENRE"
readIs
genre <- restLine
updateState( \cd -> cd{d_genre = genre})
return genre
restDiscId = do
string "ISCID"
readIs
discId <- restLine
updateState( \cd -> cd{d_id = discId})
return discId
dKeyValue = (char 'D') *> choice [restDTitle,restDYear,restDGenre,restDiscId]
keyValue = do
noHash
mySpaces
res <- choice [dKeyValue,trackTitle,garbageKeyValue]
return res
garbageKeyValue = do
key <- (manyTill anyChar (char '='))
mySpaces
val <- restLine
return $ "kvGarbage key: " `B.append` (B.pack key) `B.append` ", val: " `B.append` val
-- einde keyValue
validCd :: CD -> Bool
validCd cd = let titleStr = d_title cd `B.append` d_artist cd
(valid,invalid) =
B.foldr (\c (va,inva) -> if isAlphaNum c then
(va+1,inva)
else
(va,inva+1)) (0,0) titleStr
in valid > invalid
--validCd cd = True
parseCD :: GenParser Char CD CD
parseCD = do
setState emptyCD
commentInfo <- many commentLine
keyValues <- many keyValue
cd <- getState
let cd' = calculateTrackLengths cd
updateState (\cd -> cd')
return $ cd'
-- | omgekeerd sorteren
compOffsets :: Track -> Track -> Ordering
compOffsets t1 t2 = let off1 = t_offset t1
off2 = t_offset t2
in case compare off1 off2 of
LT -> GT
GT -> LT
EQ -> EQ
isValidTrackOffset :: Track -> Bool
isValidTrackOffset t = (t_offset t >= 0)
validDiskLength :: CD -> [Track] -> Bool
validDiskLength cd sortedTracks = if null sortedTracks then -- sortedTracks: tracks omgekeerd gesorteerd op trackoffset
False
else
let lt = head sortedTracks
in 75 * (d_lengthSec cd) > (t_offset lt) -- is de laatste offset van de disk groter dan de offset van het laatste nummer
calculateTrackLengths :: CD -> CD
calculateTrackLengths inCd = if (all isValidTrackOffset (d_tracks inCd)) then
let sortedTracks = sortBy (\tr1 tr2 -> compOffsets tr1 tr2) (d_tracks inCd) -- omgekeerde volgorde sorteren op offsets
resTracks= if null sortedTracks then
[]
else
if validDiskLength inCd sortedTracks then
let combinedTracks = zip sortedTracks (tail sortedTracks)
tracksWithLengthNoLastTrack = map (\(tHi,tLo) -> tLo {t_lengthSec = ((t_offset tHi) - (t_offset tLo)) `div` 75}) combinedTracks
lt = head sortedTracks
lt' = lt {t_lengthSec = (d_lengthSec inCd) - ((t_offset lt) `div` 75)}
tracksWithLength = lt' : tracksWithLengthNoLastTrack -- alle track lengthes zijn ingevuld
in tracksWithLength
else
sortedTracks -- geen valid disklength
in inCd {d_tracks = reverse resTracks}
--in inCd {d_tracks = sortedTracks}
else
inCd -- niet allemaal geldige trackOffsets
parseCDs :: GenParser Char CD [CD]
parseCDs = do
res <- manyTill parseCD eof
return res
parseFile hOutMVar filesChannel = do
fn <- readChan filesChannel
if (fn == "") then
do
writeChan filesChannel "" -- laatste element. Stop recursion en zet de lege string weer op de channel voor andere threads
return () --klaar
else
do
hIn <- openFile fn ReadMode
hSetEncoding hIn latin1
cont <- B.hGetContents hIn --bestand inlezen
let res = runParser parseCDs emptyCD "" cont --bestand parsen
res `seq` hClose hIn --handle sluiten
hClose hIn
let (sql,errorMsg,valCds) = case res of -- sql en errorMsg zijn een bytestrings
(Left err) -> ("",B.pack $ show err,[])
(Right cds) -> let validCds = filter validCd cds
lines = B.intercalate ",\n" ((map showCD validCds))
lines' = insertCmd `B.append` lines
in (lines' `B.append` (B.pack ";\n"),"",validCds)
-- er mag maar een thread tegelijk naar het outputbestand schrijven.
hOut <- takeMVar hOutMVar -- lock aanvragen
putStrLn fn -- schrijf filename naar scherm
--putStrLn $ show $ head valCds
if not (B.null errorMsg) then
B.putStrLn errorMsg
else
B.putStr ""
B.hPutStrLn hOut sql -- output naar file
putMVar hOutMVar hOut -- lock vrijgeven
parseFile hOutMVar filesChannel -- recurse (next file)
parseFiles hOut fns = do
tm <- TM.make
excludeWrites <- newEmptyMVar
mapM (\_ -> TM.fork tm (parseFile excludeWrites fns)) [1..4]
putMVar excludeWrites hOut -- hef de block op voor alle threads
TM.waitForAll tm --wacht tot alle forks afgelopen zijn.
getOutPutFileName = ".\\output\\CDs.sql"
main = do
start <- getCurrentTime
excludeWrites <- newEmptyMVar
files <- freeDbFiles ".\\data"
args<- getArgs
let outputFn = if null args then getOutPutFileName else head args
hOut <- openFile outputFn AppendMode
hSetEncoding hOut latin1
filesChan <- newChan
mapM_ (writeChan filesChan) files
writeChan filesChan "" -- lege map = klaar
parseFiles hOut filesChan
hClose hOut
stop <- getCurrentTime
putStrLn "klaar"
print $ diffUTCTime stop start
它包含一个帮助源：
{-# LANGUAGE OverloadedStrings #-}
module HulpFunc(trim,
rTrim,
lTrim,
splitSubStr,
removeLastChars,
splitArr,
surround,
zetHaakjes,
sqlEscape,
sqlQuote,
sqlField)
where
import Text.Parsec.ByteString(Parser)
import qualified Data.ByteString.Char8 as B
import Data.Int
snoc :: [a] -> a -> [a]
snoc [] s = [s]
snoc (c:cs) s = c: snoc cs s
splitArr :: Int -> [a] -> [[a]]
splitArr _ [] = []
splitArr idx xs = let (fi,rest)=splitAt idx xs
in fi : (splitArr idx rest)
splitSubStr :: String -> String -> (String,String)
splitSubStr "" str = (str,"")
splitSubStr subStr str = let (fi,la) = splitSubStrRecurse "" subStr str
trimmed = if fi==str then
fi
else
removeLastChars (length subStr) fi
in (trimmed, la)
splitSubStrRecurse :: String -> String -> String -> (String {-first-}, String {-last-})
splitSubStrRecurse foundPrefix subStr "" = ("","")
splitSubStrRecurse foundPrefix subStr str = let le = length subStr
c = head str
newFoundPrefix = let pf = snoc foundPrefix c
in if length pf > le then
tail pf
else
pf
in if newFoundPrefix == subStr then
([c],drop 1 str)
else
let (fi,la) = splitSubStrRecurse newFoundPrefix subStr $ tail str
in ((c : fi), la)
removeLastChars :: Int -> String -> String
removeLastChars le s = let sLe=length s
in if sLe <= le then
""
else
take (sLe-le) s
zetHaakjes :: B.ByteString -> B.ByteString
zetHaakjes s = "(" `B.append` s `B.append` ")"
surround :: B.ByteString -> B.ByteString -> B.ByteString
surround surr s = surr `B.append` (s `B.append` surr)
-- sql
sqlQuote = surround "\'"
sqlEscape :: B.ByteString -> B.ByteString
sqlEscape "" = ""
sqlEscape s = let t = sqlEscape $ B.tail s
in case (B.head s) of
'\'' -> "\\'" `B.append` t
'\"' -> "\\\"" `B.append` t
'\\' -> "\\\\" `B.append` t
c -> (B.cons c t)
sqlField = sqlQuote .sqlEscape
lTrim :: B.ByteString -> B.ByteString
lTrim "" = ""
lTrim cs = if (B.head cs ==' ') then lTrim $ B.tail cs else cs
rTrim = (B.reverse . lTrim . B.reverse)
trim :: B.ByteString -> B.ByteString
trim = rTrim . lTrim
有人可以清除此错误，还是让我朝着正确的方向前进？
答案 0 :(得分：1)
您有一个不必要的平台相关代码。使用System.FilePath代替平台无关版本。此外，省略.\\前缀，因为本地目录是隐式的。
有关平台无关路径的示例，请勿执行此操作：
getOutPutFileName = ".\\output\\CDs.sql"
而是将导入修改为所有模块（import System.FilePath）或包含更多函数import System.FilePath ((</>), ... and the rest...)。然后使用这些功能：
getOutPutFileName = "output" </> "CDs.sql"