-- | Source code reader for all types, classes, and instances in Drasil.
-- Only records the names of types and classes, not contents.
-- Meant to show instances of types within classes.
module Drasil.Meta.Analysis.SourceCodeReaderCI (extractEntryData, EntryData(..)) where

import Data.List ((\\), isInfixOf, isPrefixOf, isSuffixOf)
import System.IO (readFile')
import System.Directory (setCurrentDirectory)
import qualified Data.Text as T

import Drasil.Meta.Analysis.DirectoryController as DC (FileName)

type DataName = String
type NewtypeName = String
type ClassName = String
type DtNtName = String

-- new EntryData data type with strict fields to enforce strict file reading
data EntryData = EntryData { EntryData -> [String]
dNs :: ![DataName]
                           , EntryData -> [String]
ntNs :: ![NewtypeName]
                           , EntryData -> [String]
cNs :: ![ClassName]
                           , EntryData -> [(String, String)]
cITs :: ![(DtNtName,ClassName)]} deriving (Int -> EntryData -> ShowS
[EntryData] -> ShowS
EntryData -> String
(Int -> EntryData -> ShowS)
-> (EntryData -> String)
-> ([EntryData] -> ShowS)
-> Show EntryData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EntryData -> ShowS
showsPrec :: Int -> EntryData -> ShowS
$cshow :: EntryData -> String
show :: EntryData -> String
$cshowList :: [EntryData] -> ShowS
showList :: [EntryData] -> ShowS
Show)

-- extracts data, newtype and class names + instances (new data-oriented format)
extractEntryData :: DC.FileName -> FilePath -> IO EntryData
extractEntryData :: String -> String -> IO EntryData
extractEntryData String
fileName String
filePath = do
  String -> IO ()
setCurrentDirectory String
filePath
  scriptFile <- String -> IO String
readFile' String
fileName
  let rScriptFileLines = ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ShowS
stripWS ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String -> [String]
lines String
scriptFile
  -- removes comment lines
      scriptFileLines = [String]
rScriptFileLines [String] -> [String] -> [String]
forall a. Eq a => [a] -> [a] -> [a]
\\ (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
"--") [String]
rScriptFileLines
      dataTypes = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
"data ") [String]
scriptFileLines
      newtypeTypes = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
"newtype ") [String]
scriptFileLines
      definInstances = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
"instance ") [String]
scriptFileLines

      rAllClasslines = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
"class ") [String]
scriptFileLines
      allClasslines = (Int -> ShowS) -> [Int] -> [String] -> [String]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> ShowS
gL (Int -> [String] -> [String] -> [Int]
getIndexes Int
0 [String]
rAllClasslines [String]
rScriptFileLines) [String]
rAllClasslines

      gL Int
num String
line
        | String
"=>" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` String
line Bool -> Bool -> Bool
&& Bool -> Bool
not (String
"=>" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` String
line) = String
line
        | Bool -> Bool
not (String
"=>" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` String
line) Bool -> Bool -> Bool
&& Bool -> Bool
not (String
"(" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` String
line) Bool -> Bool -> Bool
&& String
"class" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
line = String
line
        | String
"=>" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` String
line = String
"=> " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String]
rScriptFileLines [String] -> Int -> String
forall a. HasCallStack => [a] -> Int -> a
!! (Int
num Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
        | Bool
otherwise = Int -> ShowS
gL (Int
num Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ([String]
rScriptFileLines [String] -> Int -> String
forall a. HasCallStack => [a] -> Int -> a
!! (Int
num Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))

  let dataNames = ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
' ') ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> ShowS
forall a. Eq a => [a] -> [a] -> [a]
\\ String
"data ")) [String]
dataTypes
      newtypeNames = ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
' ') ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> ShowS
forall a. Eq a => [a] -> [a] -> [a]
\\ String
"newtype ")) [String]
newtypeTypes
      ordClassNames = ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ShowS
getClassName [String]
allClasslines
      stripInstances = (String -> (String, String)) -> [String] -> [(String, String)]
forall a b. (a -> b) -> [a] -> [b]
map String -> (String, String)
getStripInstance [String]
definInstances

  return EntryData {dNs=dataNames,ntNs=newtypeNames,cNs=ordClassNames,cITs=stripInstances}

-- strips leading and trailing whitespace from strings
stripWS :: String -> String
stripWS :: ShowS
stripWS = Text -> String
T.unpack (Text -> String) -> (String -> Text) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.strip (Text -> Text) -> (String -> Text) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

-- index number, class + script lines, indexes list (for multi-line classes)
getIndexes :: Int -> [String] -> [String] -> [Int]
getIndexes :: Int -> [String] -> [String] -> [Int]
getIndexes Int
_ [String]
_ [] = []
getIndexes Int
idx [String]
clsLines (String
x:[String]
xs) = if Bool
isClassLine then [Int]
addIdx else [Int]
nextIdx where
  isClassLine :: Bool
isClassLine = String
x String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
clsLines
  addIdx :: [Int]
addIdx = Int
idx Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Int]
nextIdx
  nextIdx :: [Int]
nextIdx = Int -> [String] -> [String] -> [Int]
getIndexes (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [String]
clsLines [String]
xs

-- used to extract the class name from a raw script line
getClassName :: String -> ClassName
getClassName :: ShowS
getClassName String
rsl = if Bool
derived then String
stripDv else String
stripDf where
  derived :: Bool
derived = String
"=>" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` String
rsl
  -- operates on derived classes
  stripDv :: String
stripDv = (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
' ') ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> ShowS
forall a. Eq a => [a] -> [a] -> [a]
\\ String
"> ") ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'>') String
rsl
  -- operates on defined classes
  stripDf :: String
stripDf = (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
' ') ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ (String -> ShowS
forall a. Eq a => [a] -> [a] -> [a]
\\ String
"class ") String
rsl

-- used to extract data/newtype name + class instance name
getStripInstance :: String -> (DtNtName,ClassName)
getStripInstance :: String -> (String, String)
getStripInstance String
rsl = if Bool
derived then (String, String)
stripDv else (String, String)
stripDf where
  derived :: Bool
derived = String
"=>" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` String
rsl
  -- operates on derived class instances
  stripDv :: (String, String)
stripDv
    | String
"(" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` String
rsl = (String
stripDvLmdn,String
stripDvLmc)
    | Bool
otherwise = ([String]
stripDvLs [String] -> Int -> String
forall a. HasCallStack => [a] -> Int -> a
!! Int
1,[String] -> String
forall a. HasCallStack => [a] -> a
head [String]
stripDvLs)
  stripDvLs :: [String]
stripDvLs = String -> [String]
words (String -> [String]) -> ShowS -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> ShowS
forall a. Eq a => [a] -> [a] -> [a]
\\ String
"> ") (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'>') String
rsl
  stripDvLm :: String
stripDvLm = (String -> ShowS
forall a. Eq a => [a] -> [a] -> [a]
\\ String
"> ") ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'>') String
rsl
  stripDvLmdn :: String
stripDvLmdn = (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
')') ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> ShowS
forall a. Eq a => [a] -> [a] -> [a]
\\ String
"(") ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'(') String
stripDvLm
  stripDvLmc :: String
stripDvLmc = (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
' ') String
stripDvLm
  -- operates on defined class instances
  stripDf :: (String, String)
stripDf = ([String]
stripDfL [String] -> Int -> String
forall a. HasCallStack => [a] -> Int -> a
!! Int
1,[String] -> String
forall a. HasCallStack => [a] -> a
head [String]
stripDfL)
  stripDfL :: [String]
stripDfL = String -> [String]
words (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ (String -> ShowS
forall a. Eq a => [a] -> [a] -> [a]
\\ String
"instance ") String
rsl