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

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

import Utils.Drasil (blank)
import Language.Drasil hiding (space, Matrix)
import Language.Drasil.Expr.Development (Expr(Matrix))
import Language.Drasil.Printers (SingleLine(OneLine), exprDoc, sentenceDoc,
  unitDoc, PrintingInformation)
import Language.Drasil.Printing.Import (expr, spec)

import Language.Drasil.Code.DataDesc (DataDesc, Data(..), Delim,
  LinePattern(..), getDataInputs, isJunk)

-- | Generate a sample input file.
makeInputFile :: PrintingInformation -> DataDesc -> [Expr] -> Doc
makeInputFile :: PrintingInformation -> DataDesc -> [Expr] -> Doc
makeInputFile PrintingInformation
db DataDesc
dd [Expr]
sampData = [Doc] -> Doc
vcat (PrintingInformation -> DataDesc -> [Expr] -> [Doc]
convDataDesc PrintingInformation
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 :: PrintingInformation -> DataDesc -> [Expr] -> [Doc]
convDataDesc :: PrintingInformation -> DataDesc -> [Expr] -> [Doc]
convDataDesc PrintingInformation
_ [] (Expr
_:[Expr]
_) = [Char] -> [Doc]
forall a. HasCallStack => [Char] -> a
error ([Char] -> [Doc]) -> [Char] -> [Doc]
forall a b. (a -> b) -> a -> b
$ [Char]
"makeInputFile received more inputs" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
          [Char]
" than expected, should be impossible"
convDataDesc PrintingInformation
_ DataDesc
ds [] = if (Data -> Bool) -> DataDesc -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Data -> Bool
isJunk DataDesc
ds then Int -> Doc -> [Doc]
forall a. Int -> a -> [a]
replicate (DataDesc -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length DataDesc
ds) Doc
blank
  else [Char] -> [Doc]
forall a. HasCallStack => [Char] -> a
error [Char]
"makeInputFile received fewer inputs than expected, should be impossible"
convDataDesc PrintingInformation
db (Data
JunkData : ds :: DataDesc
ds@(Singleton DataItem
_ : DataDesc
_)) [Expr]
es = PrintingInformation -> DataDesc -> Char -> [Expr] -> [Doc]
docLine PrintingInformation
db DataDesc
ds Char
' ' [Expr]
es
convDataDesc PrintingInformation
db (Data
JunkData : ds :: DataDesc
ds@(Line LinePattern
_ Char
dl : DataDesc
_)) [Expr]
es = PrintingInformation -> DataDesc -> Char -> [Expr] -> [Doc]
docLine PrintingInformation
db DataDesc
ds Char
dl [Expr]
es
convDataDesc PrintingInformation
db (Data
JunkData : ds :: DataDesc
ds@(Lines LinePattern
_ Maybe Integer
_ Char
dl : DataDesc
_)) [Expr]
es = PrintingInformation -> DataDesc -> Char -> [Expr] -> [Doc]
docLine PrintingInformation
db DataDesc
ds Char
dl [Expr]
es
convDataDesc PrintingInformation
db (Singleton DataItem
_ : DataDesc
ds) (Expr
e:[Expr]
es) = PrintingInformation -> Expr -> Doc
eDoc PrintingInformation
db Expr
e Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: PrintingInformation -> DataDesc -> [Expr] -> [Doc]
convDataDesc PrintingInformation
db DataDesc
ds [Expr]
es
convDataDesc PrintingInformation
db (Line (Straight [DataItem]
dis) Char
dl : DataDesc
ds) [Expr]
es = let
  ([Expr]
l,[Expr]
ls) = Int -> [Expr] -> ([Expr], [Expr])
forall a. Int -> [a] -> ([a], [a])
splitAt ([DataItem] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [DataItem]
dis) [Expr]
es
  in PrintingInformation -> Char -> [Expr] -> Doc
dataLine PrintingInformation
db Char
dl [Expr]
l Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: PrintingInformation -> DataDesc -> [Expr] -> [Doc]
convDataDesc PrintingInformation
db DataDesc
ds [Expr]
ls
convDataDesc PrintingInformation
db (Line (Repeat [DataItem]
dis) Char
dl : DataDesc
ds) [Expr]
es = let
  ([Expr]
l,[Expr]
ls) = Int -> [Expr] -> ([Expr], [Expr])
forall a. Int -> [a] -> ([a], [a])
splitAt ([DataItem] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [DataItem]
dis) [Expr]
es
  in PrintingInformation -> Char -> [Expr] -> Doc
dataLine PrintingInformation
db Char
dl ([[Expr]] -> [Expr]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Expr]] -> [Expr]) -> [[Expr]] -> [Expr]
forall a b. (a -> b) -> a -> b
$ [Expr] -> [[Expr]]
orderVecs [Expr]
l)
  Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: PrintingInformation -> DataDesc -> [Expr] -> [Doc]
convDataDesc PrintingInformation
db DataDesc
ds [Expr]
ls
convDataDesc PrintingInformation
db (Lines (Straight [DataItem]
_) Maybe Integer
Nothing Char
dl : DataDesc
_) [Expr]
es = ([Expr] -> Doc) -> [[Expr]] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (PrintingInformation -> Char -> [Expr] -> Doc
dataLine PrintingInformation
db Char
dl)
  ([Expr] -> [[Expr]]
orderVecs [Expr]
es)
convDataDesc PrintingInformation
db (Lines (Straight [DataItem]
dis) (Just Integer
n) Char
dl : DataDesc
ds) [Expr]
es = let
  ([Expr]
l,[Expr]
ls) = Int -> [Expr] -> ([Expr], [Expr])
forall a. Int -> [a] -> ([a], [a])
splitAt ([DataItem] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [DataItem]
dis) [Expr]
es
  vs :: [[Expr]]
vs = [Expr] -> [[Expr]]
orderVecs [Expr]
l
  in if Int -> Integer
forall a. Integral a => a -> Integer
toInteger ([[Expr]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Expr]]
vs) Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
n then ([Expr] -> Doc) -> [[Expr]] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (PrintingInformation -> Char -> [Expr] -> Doc
dataLine PrintingInformation
db Char
dl) [[Expr]]
vs
  [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ PrintingInformation -> DataDesc -> [Expr] -> [Doc]
convDataDesc PrintingInformation
db DataDesc
ds [Expr]
ls
  else [Char] -> [Doc]
forall a. HasCallStack => [Char] -> a
error [Char]
"makeInputFile encountered wrong-sized vectors"
convDataDesc PrintingInformation
db (Lines (Repeat [DataItem]
_) Maybe Integer
Nothing Char
dl : DataDesc
_) [Expr]
es = ([[Expr]] -> Doc) -> [[[Expr]]] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map
  (PrintingInformation -> Char -> [Expr] -> Doc
dataLine PrintingInformation
db Char
dl ([Expr] -> Doc) -> ([[Expr]] -> [Expr]) -> [[Expr]] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Expr]] -> [Expr]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Expr]] -> [Expr])
-> ([[Expr]] -> [[Expr]]) -> [[Expr]] -> [Expr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Expr]] -> [[Expr]]
forall a. [[a]] -> [[a]]
transpose) ([Expr] -> [[[Expr]]]
orderMtxs [Expr]
es)
convDataDesc PrintingInformation
db (Lines (Repeat [DataItem]
dis) (Just Integer
n) Char
dl : DataDesc
ds) [Expr]
es = let
  ([Expr]
l,[Expr]
ls) = Int -> [Expr] -> ([Expr], [Expr])
forall a. Int -> [a] -> ([a], [a])
splitAt ([DataItem] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [DataItem]
dis) [Expr]
es
  ms :: [[[Expr]]]
ms = [Expr] -> [[[Expr]]]
orderMtxs [Expr]
l
  in if Int -> Integer
forall a. Integral a => a -> Integer
toInteger ([[[Expr]]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[[Expr]]]
ms) Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
n then ([[Expr]] -> Doc) -> [[[Expr]]] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map
  (PrintingInformation -> Char -> [Expr] -> Doc
dataLine PrintingInformation
db Char
dl ([Expr] -> Doc) -> ([[Expr]] -> [Expr]) -> [[Expr]] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Expr]] -> [Expr]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Expr]] -> [Expr])
-> ([[Expr]] -> [[Expr]]) -> [[Expr]] -> [Expr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Expr]] -> [[Expr]]
forall a. [[a]] -> [[a]]
transpose) [[[Expr]]]
ms
  [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ PrintingInformation -> DataDesc -> [Expr] -> [Doc]
convDataDesc PrintingInformation
db DataDesc
ds [Expr]
ls
  else [Char] -> [Doc]
forall a. HasCallStack => [Char] -> a
error [Char]
"makeInputFile encountered wrong-sized matrices"
convDataDesc PrintingInformation
db (Data
JunkData : DataDesc
ds) [Expr]
es = Doc
blank Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: PrintingInformation -> DataDesc -> [Expr] -> [Doc]
convDataDesc PrintingInformation
db DataDesc
ds [Expr]
es

-- helpers

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

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

-- | Order vectors.
orderVecs :: [Expr] -> [[Expr]]
orderVecs :: [Expr] -> [[Expr]]
orderVecs [Expr]
vs = [[Expr]] -> [[Expr]]
forall a. [[a]] -> [[a]]
transpose ([[Expr]] -> [[Expr]]) -> [[Expr]] -> [[Expr]]
forall a b. (a -> b) -> a -> b
$ (Expr -> [Expr]) -> [Expr] -> [[Expr]]
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
_ = [Char] -> [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 = [[[Expr]]] -> [[[Expr]]]
forall a. [[a]] -> [[a]]
transpose ([[[Expr]]] -> [[[Expr]]]) -> [[[Expr]]] -> [[[Expr]]]
forall a b. (a -> b) -> a -> b
$ (Expr -> [[Expr]]) -> [Expr] -> [[[Expr]]]
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
_ = [Char] -> [[Expr]]
forall a. HasCallStack => [Char] -> a
error [Char]
"makeInputFile encountered unexpected type, expected matrix"

-- | Creates a 'OneLine' 'Implementation'-stage 'sentenceDoc'.
sDoc :: PrintingInformation -> Sentence -> Doc
sDoc :: PrintingInformation -> Sentence -> Doc
sDoc PrintingInformation
pinfo = SingleLine -> Spec -> Doc
sentenceDoc SingleLine
OneLine (Spec -> Doc) -> (Sentence -> Spec) -> Sentence -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrintingInformation -> Sentence -> Spec
spec PrintingInformation
pinfo

-- | Creates a 'OneLine' 'Implementation'-stage 'exprDoc'.
eDoc :: PrintingInformation -> Expr -> Doc
eDoc :: PrintingInformation -> Expr -> Doc
eDoc PrintingInformation
pinfo Expr
e = SingleLine -> Expr -> Doc
exprDoc SingleLine
OneLine (Expr -> PrintingInformation -> Expr
expr Expr
e PrintingInformation
pinfo)

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