Banaan51
Reputation: 13
haskell source compile on Linux
This is my first post on stackoverflow so please be patient.
First of all, I don't know anything about Haskell; I program as a hobby with PHP (+HTML/CSS).
Situation
A friend of my made a parser to parse freedb textfiles to MySQL in Haskell. He made this for Windows, but now I want to compile the source to a Linux executable on Linux Mint 18.3 64bit. My friend has given me an edit to the source just before he got sick to adjust it to Linux and changed Posix from Windows
System.FilePath.Posix (addTrailingPathSeparator,splitFileName,splitPath,takeDirectory)
This source compiles very well on Linux and I get a working executable, but the problem comes when I try to run it – this error comes up:
FreeDb: .\data/ getDirectoryContents: does not exist (no such file or directory)
It should have find a data directory in the directory where the executable is started but obviously .\data/ doesn't work on linux.
Full source:
{-# 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
It includes a helper source:
{-# 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
Can someone clear this error, or put me in the right direction?
Upvotes: 1
Views: 112
Answers (1)
Thomas M. DuBuisson
Reputation: 64740
You have a unnecessary platform dependent code. Use System.FilePath instead for the platform independent version. Also, omit the .\\ prefix since the local directory is implicit.
For an example of platform independent paths, don't do this:
getOutPutFileName = ".\\output\\CDs.sql"
Instead modify your import to be either all of the module (import System.FilePath) or include more functions import System.FilePath ((</>), ... and the rest...). Then use these functions:
getOutPutFileName = "output" </> "CDs.sql"
Upvotes: 1
Related Questions
- Compile Haskell programs to C
- How to compile first haskell program
- haskell compile program nothing show
- Distributing a Haskell program as C source
- Compiling Haskell code with Cygwin
- How to package Haskell project for Linux use
- Compiling Haskell on the Raspberry Pi
- Running a compiled Haskell program:
- Compiling in GHC
- Running a compiled Haskell program; getting errors