-- | 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 -> [DataName]
dNs :: ![DataName]
                           , EntryData -> [DataName]
ntNs :: ![NewtypeName]
                           , EntryData -> [DataName]
cNs :: ![ClassName]
                           , EntryData -> [(DataName, DataName)]
cITs :: ![(DtNtName,ClassName)]} deriving (Int -> EntryData -> ShowS
[EntryData] -> ShowS
EntryData -> DataName
(Int -> EntryData -> ShowS)
-> (EntryData -> DataName)
-> ([EntryData] -> ShowS)
-> Show EntryData
forall a.
(Int -> a -> ShowS) -> (a -> DataName) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EntryData -> ShowS
showsPrec :: Int -> EntryData -> ShowS
$cshow :: EntryData -> DataName
show :: EntryData -> DataName
$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 :: DataName -> DataName -> IO EntryData
extractEntryData DataName
fileName DataName
filePath = do
  DataName -> IO ()
setCurrentDirectory DataName
filePath
  DataName
scriptFile <- DataName -> IO DataName
readFile' DataName
fileName
  let rScriptFileLines :: [DataName]
rScriptFileLines = ShowS -> [DataName] -> [DataName]
forall a b. (a -> b) -> [a] -> [b]
map ShowS
stripWS ([DataName] -> [DataName]) -> [DataName] -> [DataName]
forall a b. (a -> b) -> a -> b
$ DataName -> [DataName]
lines DataName
scriptFile
  -- removes comment lines
      scriptFileLines :: [DataName]
scriptFileLines = [DataName]
rScriptFileLines [DataName] -> [DataName] -> [DataName]
forall a. Eq a => [a] -> [a] -> [a]
\\ (DataName -> Bool) -> [DataName] -> [DataName]
forall a. (a -> Bool) -> [a] -> [a]
filter (DataName -> DataName -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf DataName
"--") [DataName]
rScriptFileLines
      dataTypes :: [DataName]
dataTypes = (DataName -> Bool) -> [DataName] -> [DataName]
forall a. (a -> Bool) -> [a] -> [a]
filter (DataName -> DataName -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf DataName
"data ") [DataName]
scriptFileLines
      newtypeTypes :: [DataName]
newtypeTypes = (DataName -> Bool) -> [DataName] -> [DataName]
forall a. (a -> Bool) -> [a] -> [a]
filter (DataName -> DataName -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf DataName
"newtype ") [DataName]
scriptFileLines
      definInstances :: [DataName]
definInstances = (DataName -> Bool) -> [DataName] -> [DataName]
forall a. (a -> Bool) -> [a] -> [a]
filter (DataName -> DataName -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf DataName
"instance ") [DataName]
scriptFileLines

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

      gL :: Int -> ShowS
gL Int
num DataName
line
        | DataName
"=>" DataName -> DataName -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` DataName
line Bool -> Bool -> Bool
&& Bool -> Bool
not (DataName
"=>" DataName -> DataName -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` DataName
line) = DataName
line
        | Bool -> Bool
not (DataName
"=>" DataName -> DataName -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` DataName
line) Bool -> Bool -> Bool
&& Bool -> Bool
not (DataName
"(" DataName -> DataName -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` DataName
line) Bool -> Bool -> Bool
&& DataName
"class" DataName -> DataName -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` DataName
line = DataName
line
        | DataName
"=>" DataName -> DataName -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` DataName
line = DataName
"=> " DataName -> ShowS
forall a. [a] -> [a] -> [a]
++ [DataName]
rScriptFileLines [DataName] -> Int -> DataName
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) ([DataName]
rScriptFileLines [DataName] -> Int -> DataName
forall a. HasCallStack => [a] -> Int -> a
!! (Int
num Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))

  let dataNames :: [DataName]
dataNames = ShowS -> [DataName] -> [DataName]
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
. (DataName -> ShowS
forall a. Eq a => [a] -> [a] -> [a]
\\ DataName
"data ")) [DataName]
dataTypes
      newtypeNames :: [DataName]
newtypeNames = ShowS -> [DataName] -> [DataName]
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
. (DataName -> ShowS
forall a. Eq a => [a] -> [a] -> [a]
\\ DataName
"newtype ")) [DataName]
newtypeTypes
      ordClassNames :: [DataName]
ordClassNames = ShowS -> [DataName] -> [DataName]
forall a b. (a -> b) -> [a] -> [b]
map ShowS
getClassName [DataName]
allClasslines
      stripInstances :: [(DataName, DataName)]
stripInstances = (DataName -> (DataName, DataName))
-> [DataName] -> [(DataName, DataName)]
forall a b. (a -> b) -> [a] -> [b]
map DataName -> (DataName, DataName)
getStripInstance [DataName]
definInstances

  EntryData -> IO EntryData
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return EntryData {dNs :: [DataName]
dNs=[DataName]
dataNames,ntNs :: [DataName]
ntNs=[DataName]
newtypeNames,cNs :: [DataName]
cNs=[DataName]
ordClassNames,cITs :: [(DataName, DataName)]
cITs=[(DataName, DataName)]
stripInstances}

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

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

-- used to extract the class name from a raw script line
getClassName :: String -> ClassName
getClassName :: ShowS
getClassName DataName
rsl = if Bool
derived then DataName
stripDv else DataName
stripDf where
  derived :: Bool
derived = DataName
"=>" DataName -> DataName -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` DataName
rsl
  -- operates on derived classes
  stripDv :: DataName
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
. (DataName -> ShowS
forall a. Eq a => [a] -> [a] -> [a]
\\ DataName
"> ") 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
'>') DataName
rsl
  -- operates on defined classes
  stripDf :: DataName
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
$ (DataName -> ShowS
forall a. Eq a => [a] -> [a] -> [a]
\\ DataName
"class ") DataName
rsl

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