-- | Defines functions for reading values from a file corresponding to a DataDesc
module Language.Drasil.Code.Imperative.ReadInput (
  sampleInputDD, readWithDataDesc
) where

import Language.Drasil hiding (Data)
import Language.Drasil.Code.DataDesc (DataDesc'(..), Data'(..), DataItem'(..), 
  Delimiter, dataDesc, junk, list, singleton')
import Language.Drasil.Chunk.Code (CodeVarChunk)
import Language.Drasil.Expr.Development (Expr(Matrix))

import Control.Lens ((^.))
import Data.List (intersperse, isPrefixOf, transpose)
import Data.List.Split (splitOn)
import Data.List.NonEmpty (NonEmpty(..), toList)

-- | Reads data from a file and converts the values to 'Expr's. The file must be 
-- formatted according to the 'DataDesc'' passed as a parameter.
readWithDataDesc :: FilePath -> DataDesc' -> IO [Expr]
readWithDataDesc :: FilePath -> DataDesc' -> IO [Expr]
readWithDataDesc fp :: FilePath
fp ddsc :: DataDesc'
ddsc = do 
  FilePath
ins <- FilePath -> IO FilePath
readFile FilePath
fp
  let readDD :: DataDesc' -> String -> [Expr]
      readDD :: DataDesc' -> FilePath -> [Expr]
readDD (DD ds :: Data'
ds dlm :: FilePath
dlm dd :: DataDesc'
dd) s :: FilePath
s = let (dat :: FilePath
dat,rest :: FilePath
rest) = FilePath -> FilePath -> (FilePath, FilePath)
splitAtFirst FilePath
s FilePath
dlm in 
        Data' -> FilePath -> [Expr]
readData Data'
ds FilePath
dat [Expr] -> [Expr] -> [Expr]
forall a. [a] -> [a] -> [a]
++ DataDesc' -> FilePath -> [Expr]
readDD DataDesc'
dd FilePath
rest
      readDD (End d :: Data'
d) s :: FilePath
s = Data' -> FilePath -> [Expr]
readData Data'
d FilePath
s
      readData :: Data' -> String -> [Expr]
      readData :: Data' -> FilePath -> [Expr]
readData Junk _ = []
      readData (Datum d :: DataItem'
d) s :: FilePath
s = [DataItem' -> FilePath -> Expr
readDataItem DataItem'
d FilePath
s]
      readData (Data dis :: NonEmpty DataItem'
dis 0 d :: FilePath
d) s :: FilePath
s = (DataItem' -> FilePath -> Expr)
-> [DataItem'] -> [FilePath] -> [Expr]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith DataItem' -> FilePath -> Expr
readDataItem (NonEmpty DataItem' -> [DataItem']
forall a. NonEmpty a -> [a]
toList NonEmpty DataItem'
dis) (FilePath -> FilePath -> [FilePath]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn FilePath
d FilePath
s) 
      readData (Data ((DI c :: CodeVarChunk
c [dlm1 :: FilePath
dlm1]):|_) 1 dlm2 :: FilePath
dlm2) s :: FilePath
s = ([FilePath] -> Expr) -> [[FilePath]] -> [Expr]
forall a b. (a -> b) -> [a] -> [b]
map (([[Expr]] -> Expr
Matrix ([[Expr]] -> Expr) -> ([Expr] -> [[Expr]]) -> [Expr] -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Expr] -> [[Expr]] -> [[Expr]]
forall a. a -> [a] -> [a]
:[])) ([Expr] -> Expr) -> ([FilePath] -> [Expr]) -> [FilePath] -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        (FilePath -> Expr) -> [FilePath] -> [Expr]
forall a b. (a -> b) -> [a] -> [b]
map (Space -> FilePath -> Expr
strAsExpr (Space -> Space
getInnerSpace (Space -> Space) -> Space -> Space
forall a b. (a -> b) -> a -> b
$ CodeVarChunk
c CodeVarChunk -> Getting Space CodeVarChunk Space -> Space
forall s a. s -> Getting a s a -> a
^. Getting Space CodeVarChunk Space
forall c. HasSpace c => Lens' c Space
typ))) ([[FilePath]] -> [Expr]) -> [[FilePath]] -> [Expr]
forall a b. (a -> b) -> a -> b
$ [[FilePath]] -> [[FilePath]]
forall a. [[a]] -> [[a]]
transpose ([[FilePath]] -> [[FilePath]]) -> [[FilePath]] -> [[FilePath]]
forall a b. (a -> b) -> a -> b
$
        (FilePath -> [FilePath]) -> [FilePath] -> [[FilePath]]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> FilePath -> [FilePath]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn FilePath
dlm2) ([FilePath] -> [[FilePath]]) -> [FilePath] -> [[FilePath]]
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> [FilePath]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn FilePath
dlm1 FilePath
s
      readData (Data ((DI c :: CodeVarChunk
c [dlm1 :: FilePath
dlm1, dlm3 :: FilePath
dlm3]):|_) 1 dlm2 :: FilePath
dlm2) s :: FilePath
s = ([[FilePath]] -> Expr) -> [[[FilePath]]] -> [Expr]
forall a b. (a -> b) -> [a] -> [b]
map ([[Expr]] -> Expr
Matrix ([[Expr]] -> Expr)
-> ([[FilePath]] -> [[Expr]]) -> [[FilePath]] -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        ([FilePath] -> [Expr]) -> [[FilePath]] -> [[Expr]]
forall a b. (a -> b) -> [a] -> [b]
map ((FilePath -> Expr) -> [FilePath] -> [Expr]
forall a b. (a -> b) -> [a] -> [b]
map (Space -> FilePath -> Expr
strAsExpr (Space -> Space
getInnerSpace (Space -> Space) -> Space -> Space
forall a b. (a -> b) -> a -> b
$ CodeVarChunk
c CodeVarChunk -> Getting Space CodeVarChunk Space -> Space
forall s a. s -> Getting a s a -> a
^. Getting Space CodeVarChunk Space
forall c. HasSpace c => Lens' c Space
typ)))) ([[[FilePath]]] -> [Expr]) -> [[[FilePath]]] -> [Expr]
forall a b. (a -> b) -> a -> b
$ [[[FilePath]]] -> [[[FilePath]]]
forall a. [[a]] -> [[a]]
transpose ([[[FilePath]]] -> [[[FilePath]]])
-> [[[FilePath]]] -> [[[FilePath]]]
forall a b. (a -> b) -> a -> b
$
        (FilePath -> [[FilePath]]) -> [FilePath] -> [[[FilePath]]]
forall a b. (a -> b) -> [a] -> [b]
map ((FilePath -> [FilePath]) -> [FilePath] -> [[FilePath]]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> FilePath -> [FilePath]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn FilePath
dlm3) ([FilePath] -> [[FilePath]])
-> (FilePath -> [FilePath]) -> FilePath -> [[FilePath]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath -> [FilePath]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn FilePath
dlm2) ([FilePath] -> [[[FilePath]]]) -> [FilePath] -> [[[FilePath]]]
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> [FilePath]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn FilePath
dlm1 FilePath
s
      readData (Data ((DI c :: CodeVarChunk
c [dlm1 :: FilePath
dlm1, dlm2 :: FilePath
dlm2]):|_) 2 dlm3 :: FilePath
dlm3) s :: FilePath
s = ([[FilePath]] -> Expr) -> [[[FilePath]]] -> [Expr]
forall a b. (a -> b) -> [a] -> [b]
map ([[Expr]] -> Expr
Matrix ([[Expr]] -> Expr)
-> ([[FilePath]] -> [[Expr]]) -> [[FilePath]] -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        ([FilePath] -> [Expr]) -> [[FilePath]] -> [[Expr]]
forall a b. (a -> b) -> [a] -> [b]
map ((FilePath -> Expr) -> [FilePath] -> [Expr]
forall a b. (a -> b) -> [a] -> [b]
map (Space -> FilePath -> Expr
strAsExpr (Space -> Space
getInnerSpace (Space -> Space) -> Space -> Space
forall a b. (a -> b) -> a -> b
$ CodeVarChunk
c CodeVarChunk -> Getting Space CodeVarChunk Space -> Space
forall s a. s -> Getting a s a -> a
^. Getting Space CodeVarChunk Space
forall c. HasSpace c => Lens' c Space
typ))) ([[FilePath]] -> [[Expr]])
-> ([[FilePath]] -> [[FilePath]]) -> [[FilePath]] -> [[Expr]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[FilePath]] -> [[FilePath]]
forall a. [[a]] -> [[a]]
transpose) ([[[FilePath]]] -> [Expr]) -> [[[FilePath]]] -> [Expr]
forall a b. (a -> b) -> a -> b
$ 
        [[[FilePath]]] -> [[[FilePath]]]
forall a. [[a]] -> [[a]]
transpose ([[[FilePath]]] -> [[[FilePath]]])
-> [[[FilePath]]] -> [[[FilePath]]]
forall a b. (a -> b) -> a -> b
$ (FilePath -> [[FilePath]]) -> [FilePath] -> [[[FilePath]]]
forall a b. (a -> b) -> [a] -> [b]
map ((FilePath -> [FilePath]) -> [FilePath] -> [[FilePath]]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> FilePath -> [FilePath]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn FilePath
dlm3) ([FilePath] -> [[FilePath]])
-> (FilePath -> [FilePath]) -> FilePath -> [[FilePath]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath -> [FilePath]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn FilePath
dlm2) ([FilePath] -> [[[FilePath]]]) -> [FilePath] -> [[[FilePath]]]
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> [FilePath]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn FilePath
dlm1 FilePath
s
      readData _ _ = FilePath -> [Expr]
forall a. HasCallStack => FilePath -> a
error "Invalid degree of intermixing in DataDesc or list with more than 2 dimensions (not yet supported)"
      -- Below match is an attempt at a generic match for Data, but it doesn't 
      -- work because the following are needed:
      --   - 1-D Vect Expr constructor
      --   - A map function on Expr Vects (exprVectMap)
      --   - A transpose function on Expr Vects (exprVectTranspose)
      -- readData (Data ((DI c dlms):dis) i dlm2) s = let (ls,rs) = splitAt i 
      --   dlms in transposeData i $ data (ls ++ [dlm] ++ rs) (getInnerType $ c ^. typ) s
      readDataItem :: DataItem' -> String -> Expr
      readDataItem :: DataItem' -> FilePath -> Expr
readDataItem (DI c :: CodeVarChunk
c []) s :: FilePath
s = Space -> FilePath -> Expr
strAsExpr (CodeVarChunk
c CodeVarChunk -> Getting Space CodeVarChunk Space -> Space
forall s a. s -> Getting a s a -> a
^. Getting Space CodeVarChunk Space
forall c. HasSpace c => Lens' c Space
typ) FilePath
s
      readDataItem (DI c :: CodeVarChunk
c [dlm :: FilePath
dlm]) s :: FilePath
s = Space -> [FilePath] -> Expr
strListAsExpr (CodeVarChunk
c CodeVarChunk -> Getting Space CodeVarChunk Space -> Space
forall s a. s -> Getting a s a -> a
^. Getting Space CodeVarChunk Space
forall c. HasSpace c => Lens' c Space
typ) (FilePath -> FilePath -> [FilePath]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn FilePath
dlm FilePath
s)
      readDataItem (DI c :: CodeVarChunk
c [dlm1 :: FilePath
dlm1, dlm2 :: FilePath
dlm2]) s :: FilePath
s = Space -> [[FilePath]] -> Expr
strList2DAsExpr (CodeVarChunk
c CodeVarChunk -> Getting Space CodeVarChunk Space -> Space
forall s a. s -> Getting a s a -> a
^. Getting Space CodeVarChunk Space
forall c. HasSpace c => Lens' c Space
typ) 
        ((FilePath -> [FilePath]) -> [FilePath] -> [[FilePath]]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> FilePath -> [FilePath]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn FilePath
dlm2) ([FilePath] -> [[FilePath]]) -> [FilePath] -> [[FilePath]]
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> [FilePath]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn FilePath
dlm1 FilePath
s)
      -- FIXME: Since the representation for vectors in Expr is Matrix, and that constructor accepts a 2-D list, building a 3-D or higher matrix is not straightforward. This would be easier if Expr had a constructor for 1-D vectors, which could be nested to achieve n-dimensional structures.
      readDataItem (DI _ _) _ = FilePath -> Expr
forall a. HasCallStack => FilePath -> a
error "readWithDataDesc does not yet support lists with 3 or more dimensions"
  [Expr] -> IO [Expr]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Expr] -> IO [Expr]) -> [Expr] -> IO [Expr]
forall a b. (a -> b) -> a -> b
$ DataDesc' -> FilePath -> [Expr]
readDD DataDesc'
ddsc FilePath
ins

-- data :: [Delimiter] -> Space -> String -> Expr
-- data [] sp s = strAsExpr sp s
-- data (d:ds) = Vect $ map (data ds) (splitOn d s)

-- transposeData :: Integer -> (Expr -> Expr)
-- transposeData 1 = exprVectTranspose
-- transposeData n = exprVectMap exprVectTranspose . transposeData (n-1)

-- | Defines the DataDesc for the file containing a sample data set, which a 
-- user must supply if they want to generate a sample input file.
sampleInputDD :: [CodeVarChunk] -> DataDesc'
sampleInputDD :: [CodeVarChunk] -> DataDesc'
sampleInputDD ds :: [CodeVarChunk]
ds = [Data'] -> FilePath -> DataDesc'
dataDesc (Data'
junk Data' -> [Data'] -> [Data']
forall a. a -> [a] -> [a]
: Data' -> [Data'] -> [Data']
forall a. a -> [a] -> [a]
intersperse Data'
junk ((CodeVarChunk -> Data') -> [CodeVarChunk] -> [Data']
forall a b. (a -> b) -> [a] -> [b]
map CodeVarChunk -> Data'
toData [CodeVarChunk]
ds)) "\n"
  where toData :: CodeVarChunk -> Data'
toData d :: CodeVarChunk
d = Space -> CodeVarChunk -> Data'
toData' (CodeVarChunk
d CodeVarChunk -> Getting Space CodeVarChunk Space -> Space
forall s a. s -> Getting a s a -> a
^. Getting Space CodeVarChunk Space
forall c. HasSpace c => Lens' c Space
typ) CodeVarChunk
d
        toData' :: Space -> CodeVarChunk -> Data'
toData' t :: Space
t@(Vect _) d :: CodeVarChunk
d = CodeVarChunk -> [FilePath] -> Data'
list CodeVarChunk
d 
          (Int -> [FilePath] -> [FilePath]
forall a. Int -> [a] -> [a]
take (Space -> Int
getDimension Space
t) ([", ", "; "] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ (FilePath -> FilePath) -> FilePath -> [FilePath]
forall a. (a -> a) -> a -> [a]
iterate (':'Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:) ":"))
        toData' _ d :: CodeVarChunk
d = CodeVarChunk -> Data'
singleton' CodeVarChunk
d

-- helpers

-- | Converts a 'String' to an 'Expr' of a given 'Space'.
strAsExpr :: Space -> String -> Expr
strAsExpr :: Space -> FilePath -> Expr
strAsExpr Integer s :: FilePath
s = Integer -> Expr
forall r. LiteralC r => Integer -> r
int (FilePath -> Integer
forall a. Read a => FilePath -> a
read FilePath
s :: Integer)
strAsExpr Natural s :: FilePath
s = Integer -> Expr
forall r. LiteralC r => Integer -> r
int (FilePath -> Integer
forall a. Read a => FilePath -> a
read FilePath
s :: Integer)
strAsExpr Radians s :: FilePath
s = Double -> Expr
forall r. LiteralC r => Double -> r
dbl (FilePath -> Double
forall a. Read a => FilePath -> a
read FilePath
s :: Double)
strAsExpr Real s :: FilePath
s = Double -> Expr
forall r. LiteralC r => Double -> r
dbl (FilePath -> Double
forall a. Read a => FilePath -> a
read FilePath
s :: Double)
strAsExpr Rational s :: FilePath
s = Double -> Expr
forall r. LiteralC r => Double -> r
dbl (FilePath -> Double
forall a. Read a => FilePath -> a
read FilePath
s :: Double)
strAsExpr String s :: FilePath
s = FilePath -> Expr
forall r. LiteralC r => FilePath -> r
str FilePath
s
strAsExpr _ _ = FilePath -> Expr
forall a. HasCallStack => FilePath -> a
error "strAsExpr should only be numeric space or string"

-- | Gets the dimension of a 'Space'.
getDimension :: Space -> Int
getDimension :: Space -> Int
getDimension (Vect t :: Space
t) = 1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Space -> Int
getDimension Space
t
getDimension _ = 0

-- | Splits a string at the first (and only the first) occurrence of a delimiter.
-- The delimiter is dropped from the result.
splitAtFirst :: String -> Delimiter -> (String, String)
splitAtFirst :: FilePath -> FilePath -> (FilePath, FilePath)
splitAtFirst = FilePath -> FilePath -> FilePath -> (FilePath, FilePath)
forall a. Eq a => [a] -> [a] -> [a] -> ([a], [a])
splitAtFirst' []
  where splitAtFirst' :: [a] -> [a] -> [a] -> ([a], [a])
splitAtFirst' acc :: [a]
acc [] _ = ([a]
acc, [])
        splitAtFirst' acc :: [a]
acc s :: [a]
s@(h :: a
h:t :: [a]
t) d :: [a]
d = if [a]
d [a] -> [a] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [a]
s then 
          ([a]
acc, [a] -> [a] -> [a]
forall a. Eq a => [a] -> [a] -> [a]
dropDelim [a]
d [a]
s) else [a] -> [a] -> [a] -> ([a], [a])
splitAtFirst' ([a]
acc[a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++[a
h]) [a]
t [a]
d
        dropDelim :: [a] -> [a] -> [a]
dropDelim (d :: a
d:ds :: [a]
ds) (s :: a
s:ss :: [a]
ss) = if a
d a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
s then [a] -> [a] -> [a]
dropDelim [a]
ds [a]
ss 
          else FilePath -> [a]
forall a. HasCallStack => FilePath -> a
error "impossible"
        dropDelim [] s :: [a]
s = [a]
s
        dropDelim _ [] = FilePath -> [a]
forall a. HasCallStack => FilePath -> a
error "impossible"

-- | Converts a list of 'String's to a Matrix 'Expr' of a given 'Space'.
strListAsExpr :: Space -> [String] -> Expr
strListAsExpr :: Space -> [FilePath] -> Expr
strListAsExpr (Vect t :: Space
t) ss :: [FilePath]
ss = [[Expr]] -> Expr
Matrix [(FilePath -> Expr) -> [FilePath] -> [Expr]
forall a b. (a -> b) -> [a] -> [b]
map (Space -> FilePath -> Expr
strAsExpr Space
t) [FilePath]
ss]
strListAsExpr _ _ = FilePath -> Expr
forall a. HasCallStack => FilePath -> a
error "strListsAsExpr called on non-vector space"

-- | Converts a 2D list of 'String's to a Matrix 'Expr' of a given 'Space'.
strList2DAsExpr :: Space -> [[String]] -> Expr
strList2DAsExpr :: Space -> [[FilePath]] -> Expr
strList2DAsExpr (Vect (Vect t :: Space
t)) sss :: [[FilePath]]
sss = [[Expr]] -> Expr
Matrix ([[Expr]] -> Expr) -> [[Expr]] -> Expr
forall a b. (a -> b) -> a -> b
$ ([FilePath] -> [Expr]) -> [[FilePath]] -> [[Expr]]
forall a b. (a -> b) -> [a] -> [b]
map ((FilePath -> Expr) -> [FilePath] -> [Expr]
forall a b. (a -> b) -> [a] -> [b]
map (Space -> FilePath -> Expr
strAsExpr Space
t)) [[FilePath]]
sss
strList2DAsExpr _ _ = FilePath -> Expr
forall a. HasCallStack => FilePath -> a
error "strLists2DAsExprs called on non-2D-vector space"