{-|
This module contains the from block parser. It loads the initial `SymbolMap`.
-}
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

-- | Loads `SymbolMap` according to a `Program` and a from block `String` in the second argument.
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