module Language.Drasil.Code.Imperative.WriteInput (
  makeInputFile
) where

import Utils.Drasil (blank)
import Database.Drasil (ChunkDB)
import Language.Drasil hiding (space, Matrix)
import Language.Drasil.Code.DataDesc (DataDesc, Data(..), Delim,
  LinePattern(..), getDataInputs, isJunk)
import Language.Drasil.Expr.Development (Expr(Matrix))
import Language.Drasil.Printers (SingleLine(OneLine), exprDoc, sentenceDoc,
  unitDoc)

import Control.Lens (view)
import Data.List (intersperse, transpose)
import Text.PrettyPrint.HughesPJ (Doc, (<+>), char, empty, hcat, parens, space,
  text, vcat)

-- | Generate a sample input file.
makeInputFile :: ChunkDB -> DataDesc -> [Expr] -> Doc
makeInputFile :: ChunkDB -> DataDesc -> [Expr] -> Doc
makeInputFile ChunkDB
db DataDesc
dd [Expr]
sampData = [Doc] -> Doc
vcat (ChunkDB -> DataDesc -> [Expr] -> [Doc]
convDataDesc ChunkDB
db DataDesc
dd [Expr]
sampData)

-- | Writes a data file formatted according to the given 'DataDesc', where the data
-- values come from the passed \['Expr'\].
convDataDesc :: ChunkDB -> DataDesc -> [Expr] -> [Doc]
convDataDesc :: ChunkDB -> DataDesc -> [Expr] -> [Doc]
convDataDesc ChunkDB
_ [] (Expr
_:[Expr]
_) = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"makeInputFile received more inputs" forall a. [a] -> [a] -> [a]
++
          [Char]
" than expected, should be impossible"
convDataDesc ChunkDB
_ DataDesc
ds [] = if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Data -> Bool
isJunk DataDesc
ds then forall a. Int -> a -> [a]
replicate (forall (t :: * -> *) a. Foldable t => t a -> Int
length DataDesc
ds) Doc
blank
  else forall a. HasCallStack => [Char] -> a
error [Char]
"makeInputFile received fewer inputs than expected, should be impossible"
convDataDesc ChunkDB
db (Data
JunkData : ds :: DataDesc
ds@(Singleton CodeVarChunk
_ : DataDesc
_)) [Expr]
es = ChunkDB -> DataDesc -> Char -> [Expr] -> [Doc]
docLine ChunkDB
db DataDesc
ds Char
' ' [Expr]
es
convDataDesc ChunkDB
db (Data
JunkData : ds :: DataDesc
ds@(Line LinePattern
_ Char
dl : DataDesc
_)) [Expr]
es = ChunkDB -> DataDesc -> Char -> [Expr] -> [Doc]
docLine ChunkDB
db DataDesc
ds Char
dl [Expr]
es
convDataDesc ChunkDB
db (Data
JunkData : ds :: DataDesc
ds@(Lines LinePattern
_ Maybe Integer
_ Char
dl : DataDesc
_)) [Expr]
es = ChunkDB -> DataDesc -> Char -> [Expr] -> [Doc]
docLine ChunkDB
db DataDesc
ds Char
dl [Expr]
es
convDataDesc ChunkDB
db (Singleton CodeVarChunk
_ : DataDesc
ds) (Expr
e:[Expr]
es) = ChunkDB -> Expr -> Doc
eDoc ChunkDB
db Expr
e forall a. a -> [a] -> [a]
: ChunkDB -> DataDesc -> [Expr] -> [Doc]
convDataDesc ChunkDB
db DataDesc
ds [Expr]
es
convDataDesc ChunkDB
db (Line (Straight [CodeVarChunk]
dis) Char
dl : DataDesc
ds) [Expr]
es = let
  ([Expr]
l,[Expr]
ls) = forall a. Int -> [a] -> ([a], [a])
splitAt (forall (t :: * -> *) a. Foldable t => t a -> Int
length [CodeVarChunk]
dis) [Expr]
es
  in ChunkDB -> Char -> [Expr] -> Doc
dataLine ChunkDB
db Char
dl [Expr]
l forall a. a -> [a] -> [a]
: ChunkDB -> DataDesc -> [Expr] -> [Doc]
convDataDesc ChunkDB
db DataDesc
ds [Expr]
ls
convDataDesc ChunkDB
db (Line (Repeat [CodeVarChunk]
dis) Char
dl : DataDesc
ds) [Expr]
es = let
  ([Expr]
l,[Expr]
ls) = forall a. Int -> [a] -> ([a], [a])
splitAt (forall (t :: * -> *) a. Foldable t => t a -> Int
length [CodeVarChunk]
dis) [Expr]
es
  in ChunkDB -> Char -> [Expr] -> Doc
dataLine ChunkDB
db Char
dl (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ [Expr] -> [[Expr]]
orderVecs [Expr]
l)
  forall a. a -> [a] -> [a]
: ChunkDB -> DataDesc -> [Expr] -> [Doc]
convDataDesc ChunkDB
db DataDesc
ds [Expr]
ls
convDataDesc ChunkDB
db (Lines (Straight [CodeVarChunk]
_) Maybe Integer
Nothing Char
dl : DataDesc
_) [Expr]
es = forall a b. (a -> b) -> [a] -> [b]
map (ChunkDB -> Char -> [Expr] -> Doc
dataLine ChunkDB
db Char
dl)
  ([Expr] -> [[Expr]]
orderVecs [Expr]
es)
convDataDesc ChunkDB
db (Lines (Straight [CodeVarChunk]
dis) (Just Integer
n) Char
dl : DataDesc
ds) [Expr]
es = let
  ([Expr]
l,[Expr]
ls) = forall a. Int -> [a] -> ([a], [a])
splitAt (forall (t :: * -> *) a. Foldable t => t a -> Int
length [CodeVarChunk]
dis) [Expr]
es
  vs :: [[Expr]]
vs = [Expr] -> [[Expr]]
orderVecs [Expr]
l
  in if forall a. Integral a => a -> Integer
toInteger (forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Expr]]
vs) forall a. Eq a => a -> a -> Bool
== Integer
n then forall a b. (a -> b) -> [a] -> [b]
map (ChunkDB -> Char -> [Expr] -> Doc
dataLine ChunkDB
db Char
dl) [[Expr]]
vs
  forall a. [a] -> [a] -> [a]
++ ChunkDB -> DataDesc -> [Expr] -> [Doc]
convDataDesc ChunkDB
db DataDesc
ds [Expr]
ls
  else forall a. HasCallStack => [Char] -> a
error [Char]
"makeInputFile encountered wrong-sized vectors"
convDataDesc ChunkDB
db (Lines (Repeat [CodeVarChunk]
_) Maybe Integer
Nothing Char
dl : DataDesc
_) [Expr]
es = forall a b. (a -> b) -> [a] -> [b]
map
  (ChunkDB -> Char -> [Expr] -> Doc
dataLine ChunkDB
db Char
dl forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [[a]] -> [[a]]
transpose) ([Expr] -> [[[Expr]]]
orderMtxs [Expr]
es)
convDataDesc ChunkDB
db (Lines (Repeat [CodeVarChunk]
dis) (Just Integer
n) Char
dl : DataDesc
ds) [Expr]
es = let
  ([Expr]
l,[Expr]
ls) = forall a. Int -> [a] -> ([a], [a])
splitAt (forall (t :: * -> *) a. Foldable t => t a -> Int
length [CodeVarChunk]
dis) [Expr]
es
  ms :: [[[Expr]]]
ms = [Expr] -> [[[Expr]]]
orderMtxs [Expr]
l
  in if forall a. Integral a => a -> Integer
toInteger (forall (t :: * -> *) a. Foldable t => t a -> Int
length [[[Expr]]]
ms) forall a. Eq a => a -> a -> Bool
== Integer
n then forall a b. (a -> b) -> [a] -> [b]
map
  (ChunkDB -> Char -> [Expr] -> Doc
dataLine ChunkDB
db Char
dl forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [[a]] -> [[a]]
transpose) [[[Expr]]]
ms
  forall a. [a] -> [a] -> [a]
++ ChunkDB -> DataDesc -> [Expr] -> [Doc]
convDataDesc ChunkDB
db DataDesc
ds [Expr]
ls
  else forall a. HasCallStack => [Char] -> a
error [Char]
"makeInputFile encountered wrong-sized matrices"
convDataDesc ChunkDB
db (Data
JunkData : DataDesc
ds) [Expr]
es = Doc
blank forall a. a -> [a] -> [a]
: ChunkDB -> DataDesc -> [Expr] -> [Doc]
convDataDesc ChunkDB
db DataDesc
ds [Expr]
es

-- helpers

-- | Helper to create a data line with the given delimeter.
dataLine :: ChunkDB -> Delim -> [Expr] -> Doc
dataLine :: ChunkDB -> Char -> [Expr] -> Doc
dataLine ChunkDB
db Char
dl = [Doc] -> Doc
hcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> [a] -> [a]
intersperse (Char -> Doc
char Char
dl) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (ChunkDB -> Expr -> Doc
eDoc ChunkDB
db)

-- | Helper to create document lines with a data description, delimiter, and expressions.
docLine :: ChunkDB -> DataDesc -> Delim -> [Expr] -> [Doc]
docLine :: ChunkDB -> DataDesc -> Char -> [Expr] -> [Doc]
docLine ChunkDB
db DataDesc
ds Char
dl [Expr]
es = let dis :: [CodeVarChunk]
dis = Data -> [CodeVarChunk]
getDataInputs (forall a. [a] -> a
head DataDesc
ds)
  in [Char] -> Doc
text [Char]
"#" Doc -> Doc -> Doc
<+> [Doc] -> Doc
hcat (forall a. a -> [a] -> [a]
intersperse (Char -> Doc
char Char
dl forall a. Semigroup a => a -> a -> a
<> Doc
space)
  (forall a b. (a -> b) -> [a] -> [b]
map (\CodeVarChunk
di -> (ChunkDB -> Sentence -> Doc
sDoc ChunkDB
db forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. NounPhrase n => n -> Sentence
phraseNP forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall c. NamedIdea c => Lens' c NP
term) CodeVarChunk
di Doc -> Doc -> Doc
<+>
  forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
empty (Doc -> Doc
parens forall b c a. (b -> c) -> (a -> b) -> a -> c
. USymb -> Doc
uDoc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall u. HasUnitSymbol u => u -> USymb
usymb) (forall u. MayHaveUnit u => u -> Maybe UnitDefn
getUnit CodeVarChunk
di)) [CodeVarChunk]
dis))
  forall a. a -> [a] -> [a]
: ChunkDB -> DataDesc -> [Expr] -> [Doc]
convDataDesc ChunkDB
db DataDesc
ds [Expr]
es

-- | Order vectors.
orderVecs :: [Expr] -> [[Expr]]
orderVecs :: [Expr] -> [[Expr]]
orderVecs [Expr]
vs = forall a. [[a]] -> [[a]]
transpose forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Expr -> [Expr]
getVecList [Expr]
vs

-- | Helper to get a vector (singular 'Matrix') in list form.
getVecList :: Expr -> [Expr]
getVecList :: Expr -> [Expr]
getVecList (Matrix [[Expr]
l]) = [Expr]
l
getVecList Expr
_ = forall a. HasCallStack => [Char] -> a
error [Char]
"makeInputFile encountered unexpected type, expected vector"

-- | Order matricies.
orderMtxs :: [Expr] -> [[[Expr]]]
orderMtxs :: [Expr] -> [[[Expr]]]
orderMtxs [Expr]
ms = forall a. [[a]] -> [[a]]
transpose forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Expr -> [[Expr]]
getMtxLists [Expr]
ms

-- | Helper to get a 'Matrix' in a 2D list form.
getMtxLists :: Expr -> [[Expr]]
getMtxLists :: Expr -> [[Expr]]
getMtxLists (Matrix [[Expr]]
l) = [[Expr]]
l
getMtxLists Expr
_ = forall a. HasCallStack => [Char] -> a
error [Char]
"makeInputFile encountered unexpected type, expected matrix"

-- | Creates a 'OneLine' 'Implementation'-stage 'sentenceDoc'.
sDoc :: ChunkDB -> Sentence -> Doc
sDoc :: ChunkDB -> Sentence -> Doc
sDoc ChunkDB
db = ChunkDB -> Stage -> SingleLine -> Sentence -> Doc
sentenceDoc ChunkDB
db Stage
Implementation SingleLine
OneLine

-- | Creates a 'OneLine' 'Implementation'-stage 'exprDoc'.
eDoc :: ChunkDB -> Expr -> Doc
eDoc :: ChunkDB -> Expr -> Doc
eDoc ChunkDB
db = ChunkDB -> Stage -> SingleLine -> Expr -> Doc
exprDoc ChunkDB
db Stage
Implementation SingleLine
OneLine

-- | Creates a 'OneLine' 'unitDoc'.
uDoc :: USymb -> Doc
uDoc :: USymb -> Doc
uDoc = SingleLine -> USymb -> Doc
unitDoc SingleLine
OneLine