module Lsql.Csv.Lang.From.Block(getFromSymbols) where
import Lsql.Csv.Core.Tables
import Lsql.Csv.Core.Symbols
import Lsql.Csv.Lang.From.CsvParser
import Lsql.Csv.Lang.Options
import Lsql.Csv.Lang.Args
import Lsql.Csv.Utils.BracketExpansion
import System.IO
import System.Environment
import Text.Parsec
import Text.Parsec.Prim
import Text.Parsec.Combinator
import Text.Parsec.Text
import Text.Parsec.Char
import System.FilePath.Glob
import qualified Data.Text as T
assignP :: Parser String
assignP :: Parser FilePath
assignP = do
FilePath
ret <- ParsecT Text () Identity Char -> Parser FilePath
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1(ParsecT Text () Identity Char -> Parser FilePath)
-> ParsecT Text () Identity Char -> Parser FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
FilePath -> ParsecT s u m Char
noneOf FilePath
"= \n\t"
Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'='
FilePath -> Parser FilePath
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
ret
data FileName = ExoticFileName String | WildCards [String]
exoticFileName :: Parser FileName
exoticFileName :: Parser FileName
exoticFileName = do
Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'`'
FilePath
ret <- ParsecT Text () Identity Char -> Parser FilePath
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1(ParsecT Text () Identity Char -> Parser FilePath)
-> ParsecT Text () Identity Char -> Parser FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
FilePath -> ParsecT s u m Char
noneOf FilePath
"`"
Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'`'
FileName -> Parser FileName
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return(FileName -> Parser FileName) -> FileName -> Parser FileName
forall a b. (a -> b) -> a -> b
$ FilePath -> FileName
ExoticFileName FilePath
ret
wildCards :: Parser FileName
wildCards :: Parser FileName
wildCards = do
FilePath
file_n <- ParsecT Text () Identity Char -> Parser FilePath
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1(ParsecT Text () Identity Char -> Parser FilePath)
-> ParsecT Text () Identity Char -> Parser FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
FilePath -> ParsecT s u m Char
noneOf FilePath
" \n\t"
FileName -> Parser FileName
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return(FileName -> Parser FileName) -> FileName -> Parser FileName
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FileName
WildCards([FilePath] -> FileName) -> [FilePath] -> FileName
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath]
bracketExpand FilePath
file_n
data FileAssignment =
FileAssignment FileName [Option] | NamedFileAssignment String FileAssignment
stdinFileP :: Parser FileName
stdinFileP :: Parser FileName
stdinFileP = do
Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-'
FileName -> Parser FileName
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return(FileName -> Parser FileName) -> FileName -> Parser FileName
forall a b. (a -> b) -> a -> b
$ FilePath -> FileName
ExoticFileName FilePath
"-"
optionSpaceParser :: Parser Option
optionSpaceParser :: Parser Option
optionSpaceParser = do
Option
ret <- Parser Option
optionParser
ParsecT Text () Identity Char -> Parser FilePath
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Text () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space
Option -> Parser Option
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return(Option -> Parser Option) -> Option -> Parser Option
forall a b. (a -> b) -> a -> b
$ Option
ret
unnamedFileP :: Parser FileAssignment
unnamedFileP :: Parser FileAssignment
unnamedFileP = do
FileName
file_name <- Parser FileName
stdinFileP Parser FileName -> Parser FileName -> Parser FileName
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser FileName
exoticFileName Parser FileName -> Parser FileName -> Parser FileName
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser FileName
wildCards
ParsecT Text () Identity Char -> Parser FilePath
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Text () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space
[Option]
options <- Parser Option -> ParsecT Text () Identity [Option]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many(Parser Option -> ParsecT Text () Identity [Option])
-> Parser Option -> ParsecT Text () Identity [Option]
forall a b. (a -> b) -> a -> b
$ (Parser Option -> Parser Option
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parser Option
optionSpaceParser)
FileAssignment -> Parser FileAssignment
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return(FileAssignment -> Parser FileAssignment)
-> FileAssignment -> Parser FileAssignment
forall a b. (a -> b) -> a -> b
$ FileName -> [Option] -> FileAssignment
FileAssignment FileName
file_name [Option]
options
namedFileP :: Parser FileAssignment
namedFileP :: Parser FileAssignment
namedFileP = do
FilePath
name <- Parser FilePath
assignP
FileAssignment
rest <- Parser FileAssignment
unnamedFileP
FileAssignment -> Parser FileAssignment
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return(FileAssignment -> Parser FileAssignment)
-> FileAssignment -> Parser FileAssignment
forall a b. (a -> b) -> a -> b
$ FilePath -> FileAssignment -> FileAssignment
NamedFileAssignment FilePath
name FileAssignment
rest
fileP :: Parser FileAssignment
fileP :: Parser FileAssignment
fileP = do
ParsecT Text () Identity Char -> ParsecT Text () Identity ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT Text () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space
FileAssignment
ret <- (Parser FileAssignment -> Parser FileAssignment
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parser FileAssignment
namedFileP) Parser FileAssignment
-> Parser FileAssignment -> Parser FileAssignment
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser FileAssignment
unnamedFileP
ParsecT Text () Identity Char -> ParsecT Text () Identity ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT Text () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space
FileAssignment -> Parser FileAssignment
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return FileAssignment
ret
filesP :: Parser [FileAssignment]
filesP :: Parser [FileAssignment]
filesP = do
[FileAssignment]
ret <- Parser FileAssignment -> Parser [FileAssignment]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many Parser FileAssignment
fileP
[FileAssignment] -> Parser [FileAssignment]
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return [FileAssignment]
ret
parseFromBlock :: String -> [FileAssignment]
parseFromBlock :: FilePath -> [FileAssignment]
parseFromBlock FilePath
content =
case Parser [FileAssignment]
-> FilePath -> Text -> Either ParseError [FileAssignment]
forall s t a.
Stream s Identity t =>
Parsec s () a -> FilePath -> s -> Either ParseError a
parse Parser [FileAssignment]
filesP FilePath
"from block"(Text -> Either ParseError [FileAssignment])
-> Text -> Either ParseError [FileAssignment]
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack FilePath
content of
Left ParseError
err -> FilePath -> [FileAssignment]
forall a. HasCallStack => FilePath -> a
error(FilePath -> [FileAssignment]) -> FilePath -> [FileAssignment]
forall a b. (a -> b) -> a -> b
$ ParseError -> FilePath
forall a. Show a => a -> FilePath
show ParseError
err
Right [FileAssignment]
parsed -> [FileAssignment]
parsed
wildcardExpand :: FileAssignment -> IO [String]
wildcardExpand :: FileAssignment -> IO [FilePath]
wildcardExpand (NamedFileAssignment FilePath
_ FileAssignment
a) = FileAssignment -> IO [FilePath]
wildcardExpand FileAssignment
a
wildcardExpand (FileAssignment (ExoticFileName FilePath
s) [Option]
_) = do
[FilePath] -> IO [FilePath]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [FilePath
s]
wildcardExpand (FileAssignment (WildCards [FilePath]
wcs) [Option]
_) = do
[[FilePath]]
resolved <- (FilePath -> IO [FilePath]) -> [FilePath] -> IO [[FilePath]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM FilePath -> IO [FilePath]
custGlob [FilePath]
wcs
[FilePath] -> IO [FilePath]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return([FilePath] -> IO [FilePath]) -> [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[FilePath]]
resolved
where
custGlob :: String -> IO [String]
custGlob :: FilePath -> IO [FilePath]
custGlob FilePath
x = do
[FilePath]
ret <- FilePath -> IO [FilePath]
glob FilePath
x
if [FilePath]
ret [FilePath] -> [FilePath] -> Bool
forall a. Eq a => a -> a -> Bool
/= [] then
[FilePath] -> IO [FilePath]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [FilePath]
ret
else
[FilePath] -> IO [FilePath]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [FilePath
x]
getNames :: FileAssignment -> [String]
getNames :: FileAssignment -> [FilePath]
getNames (NamedFileAssignment FilePath
name FileAssignment
rest) = FilePath
name FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: FileAssignment -> [FilePath]
getNames FileAssignment
rest
getNames (FileAssignment
_) = []
getOptions :: FileAssignment -> [Option]
getOptions :: FileAssignment -> [Option]
getOptions (NamedFileAssignment FilePath
_ FileAssignment
rest) = FileAssignment -> [Option]
getOptions FileAssignment
rest
getOptions (FileAssignment FileName
_ [Option]
options) = [Option]
options
getFromSymbols :: Program -> String -> IO SymbolMap
getFromSymbols :: Program -> FilePath -> IO SymbolMap
getFromSymbols Program
prog FilePath
from_block = do
let file_assignments :: [FileAssignment]
file_assignments = FilePath -> [FileAssignment]
parseFromBlock FilePath
from_block
[[FilePath]]
expanded <- (FileAssignment -> IO [FilePath])
-> [FileAssignment] -> IO [[FilePath]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM FileAssignment -> IO [FilePath]
wildcardExpand [FileAssignment]
file_assignments
let no_expanded :: [([FilePath], [FilePath], [Option])]
no_expanded = [[FilePath]]
-> [[FilePath]]
-> [[Option]]
-> [([FilePath], [FilePath], [Option])]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [[FilePath]]
expanded ((FileAssignment -> [FilePath]) -> [FileAssignment] -> [[FilePath]]
forall a b. (a -> b) -> [a] -> [b]
map FileAssignment -> [FilePath]
getNames [FileAssignment]
file_assignments) ((FileAssignment -> [Option]) -> [FileAssignment] -> [[Option]]
forall a b. (a -> b) -> [a] -> [b]
map FileAssignment -> [Option]
getOptions [FileAssignment]
file_assignments)
let assignments :: [Assignment]
assignments = ((Int, [FilePath], FilePath, [Option]) -> Assignment)
-> [(Int, [FilePath], FilePath, [Option])] -> [Assignment]
forall a b. (a -> b) -> [a] -> [b]
map (Int, [FilePath], FilePath, [Option]) -> Assignment
getAssignment([(Int, [FilePath], FilePath, [Option])] -> [Assignment])
-> [(Int, [FilePath], FilePath, [Option])] -> [Assignment]
forall a b. (a -> b) -> a -> b
$ Int
-> [([FilePath], [FilePath], [Option])]
-> [(Int, [FilePath], FilePath, [Option])]
distribute Int
1 [([FilePath], [FilePath], [Option])]
no_expanded
[Table]
tables <- (Assignment -> IO Table) -> [Assignment] -> IO [Table]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Assignment -> IO Table
parseFile [Assignment]
assignments
SymbolMap -> IO SymbolMap
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return(SymbolMap -> IO SymbolMap) -> SymbolMap -> IO SymbolMap
forall a b. (a -> b) -> a -> b
$ [Table] -> SymbolMap
getSymbolMap [Table]
tables
where
distribute :: Int -> [([String], [String], [Option])] -> [(Int, [String], String, [Option])]
distribute :: Int
-> [([FilePath], [FilePath], [Option])]
-> [(Int, [FilePath], FilePath, [Option])]
distribute Int
_ [] = []
distribute Int
idx (([FilePath]
paths, [FilePath]
names, [Option]
options) : [([FilePath], [FilePath], [Option])]
rest) =
let pth_length :: Int
pth_length = [FilePath] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length([FilePath] -> Int) -> [FilePath] -> Int
forall a b. (a -> b) -> a -> b
$ [FilePath]
paths in
[(Int
i, [FilePath]
names, FilePath
path, [Option]
options)| (Int
i, FilePath
path) <- [Int] -> [FilePath] -> [(Int, FilePath)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
idx..] [FilePath]
paths] [(Int, [FilePath], FilePath, [Option])]
-> [(Int, [FilePath], FilePath, [Option])]
-> [(Int, [FilePath], FilePath, [Option])]
forall a. [a] -> [a] -> [a]
++
Int
-> [([FilePath], [FilePath], [Option])]
-> [(Int, [FilePath], FilePath, [Option])]
distribute (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
pth_length) [([FilePath], [FilePath], [Option])]
rest
getAssignment :: (Int, [String], String, [Option]) -> Assignment
getAssignment :: (Int, [FilePath], FilePath, [Option]) -> Assignment
getAssignment (Int
idx, FilePath
name : [FilePath]
rest, FilePath
path, [Option]
options) =
FilePath -> Assignment -> Assignment
NamedCsv FilePath
name (Assignment -> Assignment) -> Assignment -> Assignment
forall a b. (a -> b) -> a -> b
$ (Int, [FilePath], FilePath, [Option]) -> Assignment
getAssignment (Int
idx, [FilePath]
rest, FilePath
path, [Option]
options)
getAssignment (Int
idx, [], FilePath
path, [Option]
options) = Int -> FilePath -> Program -> [Option] -> Assignment
CoreCsv Int
idx FilePath
path Program
prog [Option]
options