{-# LANGUAGE DerivingStrategies         #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE NoImplicitPrelude          #-}
{-# LANGUAGE StrictData                 #-}
{-# LANGUAGE TypeApplications           #-}
{-# LANGUAGE ViewPatterns               #-}

{-|
Module      : Headroom.SourceCode
Description : Type safe representation of analyzed source code
Copyright   : (c) 2019-2021 Vaclav Svejcar
License     : BSD-3-Clause
Maintainer  : vaclav.svejcar@gmail.com
Stability   : experimental
Portability : POSIX

This module contains data types and function used for analysis and type safe
representation of source code files.
-}

module Headroom.SourceCode
  ( -- * Data Types
    LineType(..)
  , CodeLine
  , SourceCode(..)
    -- * Functions
  , fromText
  , toText
  , firstMatching
  , lastMatching
  , stripStart
  , stripEnd
  , cut
  )
where

import           Control.Monad.State                 ( State
                                                     , evalState
                                                     )
import           Headroom.Data.Coerce                ( coerce
                                                     , inner
                                                     )
import           Headroom.Data.Text                  ( fromLines
                                                     , toLines
                                                     )
import           RIO
import qualified RIO.List                           as L
import qualified RIO.Text                           as T


---------------------------------  DATA TYPES  ---------------------------------

-- | Represents type of the line in source code.
data LineType
  = Code    -- ^ Line of code
  | Comment -- ^ Line of comment
  deriving (LineType -> LineType -> Bool
(LineType -> LineType -> Bool)
-> (LineType -> LineType -> Bool) -> Eq LineType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LineType -> LineType -> Bool
$c/= :: LineType -> LineType -> Bool
== :: LineType -> LineType -> Bool
$c== :: LineType -> LineType -> Bool
Eq, Int -> LineType -> ShowS
[LineType] -> ShowS
LineType -> String
(Int -> LineType -> ShowS)
-> (LineType -> String) -> ([LineType] -> ShowS) -> Show LineType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LineType] -> ShowS
$cshowList :: [LineType] -> ShowS
show :: LineType -> String
$cshow :: LineType -> String
showsPrec :: Int -> LineType -> ShowS
$cshowsPrec :: Int -> LineType -> ShowS
Show)

-- | Type alias for analyzed line of code.
type CodeLine = (LineType, Text)

-- | Represents analyzed source code.
newtype SourceCode
  = SourceCode [CodeLine]
  deriving stock (SourceCode -> SourceCode -> Bool
(SourceCode -> SourceCode -> Bool)
-> (SourceCode -> SourceCode -> Bool) -> Eq SourceCode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SourceCode -> SourceCode -> Bool
$c/= :: SourceCode -> SourceCode -> Bool
== :: SourceCode -> SourceCode -> Bool
$c== :: SourceCode -> SourceCode -> Bool
Eq, Int -> SourceCode -> ShowS
[SourceCode] -> ShowS
SourceCode -> String
(Int -> SourceCode -> ShowS)
-> (SourceCode -> String)
-> ([SourceCode] -> ShowS)
-> Show SourceCode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SourceCode] -> ShowS
$cshowList :: [SourceCode] -> ShowS
show :: SourceCode -> String
$cshow :: SourceCode -> String
showsPrec :: Int -> SourceCode -> ShowS
$cshowsPrec :: Int -> SourceCode -> ShowS
Show)
  deriving newtype (b -> SourceCode -> SourceCode
NonEmpty SourceCode -> SourceCode
SourceCode -> SourceCode -> SourceCode
(SourceCode -> SourceCode -> SourceCode)
-> (NonEmpty SourceCode -> SourceCode)
-> (forall b. Integral b => b -> SourceCode -> SourceCode)
-> Semigroup SourceCode
forall b. Integral b => b -> SourceCode -> SourceCode
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> SourceCode -> SourceCode
$cstimes :: forall b. Integral b => b -> SourceCode -> SourceCode
sconcat :: NonEmpty SourceCode -> SourceCode
$csconcat :: NonEmpty SourceCode -> SourceCode
<> :: SourceCode -> SourceCode -> SourceCode
$c<> :: SourceCode -> SourceCode -> SourceCode
Semigroup, Semigroup SourceCode
SourceCode
Semigroup SourceCode
-> SourceCode
-> (SourceCode -> SourceCode -> SourceCode)
-> ([SourceCode] -> SourceCode)
-> Monoid SourceCode
[SourceCode] -> SourceCode
SourceCode -> SourceCode -> SourceCode
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [SourceCode] -> SourceCode
$cmconcat :: [SourceCode] -> SourceCode
mappend :: SourceCode -> SourceCode -> SourceCode
$cmappend :: SourceCode -> SourceCode -> SourceCode
mempty :: SourceCode
$cmempty :: SourceCode
$cp1Monoid :: Semigroup SourceCode
Monoid)


------------------------------  PUBLIC FUNCTIONS  ------------------------------

-- | Converts 'Text' into 'SourceCode' using the given function to analyze
-- each line's 'LineType'. The analyzing function can hold any state that is
-- accumulated as the text is processed, for example to hold some info about
-- already processed lines.
fromText :: a
         -- ^ initial state of analyzing function
         -> (Text -> State a LineType)
         -- ^ function that analyzes currently processed line
         -> Text
         -- ^ raw source code to analyze
         -> SourceCode
         -- ^ analyzed 'SourceCode'
fromText :: a -> (Text -> State a LineType) -> Text -> SourceCode
fromText a
s0 Text -> State a LineType
f (Text -> [Text]
toLines -> [Text]
ls) = [(LineType, Text)] -> SourceCode
coerce ([(LineType, Text)] -> SourceCode)
-> [(LineType, Text)] -> SourceCode
forall a b. (a -> b) -> a -> b
$ [LineType] -> [Text] -> [(LineType, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip (State a [LineType] -> a -> [LineType]
forall s a. State s a -> s -> a
evalState ((Text -> State a LineType) -> [Text] -> State a [LineType]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Text -> State a LineType
f [Text]
ls) a
s0) [Text]
ls


-- | Converts analyzed 'SourceCode' back into 'Text'.
toText :: SourceCode
       -- ^ source code to convert back to plain text
       -> Text
       -- ^ resulting plain text
toText :: SourceCode -> Text
toText (SourceCode [(LineType, Text)]
sc) = [Text] -> Text
fromLines ([Text] -> Text)
-> ([(LineType, Text)] -> [Text]) -> [(LineType, Text)] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((LineType, Text) -> Text) -> [(LineType, Text)] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (LineType, Text) -> Text
forall a b. (a, b) -> b
snd ([(LineType, Text)] -> Text) -> [(LineType, Text)] -> Text
forall a b. (a -> b) -> a -> b
$ [(LineType, Text)]
sc


-- | Finds very first line matching given predicate and optionally performs some
-- operation over it.
firstMatching :: (CodeLine -> Maybe a)
              -- ^ predicate (and transform) function
              -> SourceCode
              -- ^ source code to search in
              -> Maybe (Int, a)
              -- ^ first matching line (if found)
firstMatching :: ((LineType, Text) -> Maybe a) -> SourceCode -> Maybe (Int, a)
firstMatching (LineType, Text) -> Maybe a
f SourceCode
sc = [(LineType, Text)] -> Int -> Maybe (Int, a)
forall t. Num t => [(LineType, Text)] -> t -> Maybe (t, a)
go (SourceCode -> [(LineType, Text)]
coerce SourceCode
sc) Int
0
 where
  go :: [(LineType, Text)] -> t -> Maybe (t, a)
go [] t
_ = Maybe (t, a)
forall a. Maybe a
Nothing
  go ((LineType, Text)
x : [(LineType, Text)]
xs) t
i | Just a
res <- (LineType, Text) -> Maybe a
f (LineType, Text)
x = (t, a) -> Maybe (t, a)
forall a. a -> Maybe a
Just (t
i, a
res)
                | Bool
otherwise       = [(LineType, Text)] -> t -> Maybe (t, a)
go [(LineType, Text)]
xs (t
i t -> t -> t
forall a. Num a => a -> a -> a
+ t
1)


-- | Finds very last line matching given predicate and optionally performs some
-- operation over it.
lastMatching :: (CodeLine -> Maybe a)
             -- ^ predicate (and transform) function
             -> SourceCode
             -- ^ source code to search in
             -> Maybe (Int, a)
             -- ^ last matching line (if found)
lastMatching :: ((LineType, Text) -> Maybe a) -> SourceCode -> Maybe (Int, a)
lastMatching (LineType, Text) -> Maybe a
f SourceCode
sc =
  let matching :: Maybe (Int, a)
matching = ((LineType, Text) -> Maybe a) -> SourceCode -> Maybe (Int, a)
forall a.
((LineType, Text) -> Maybe a) -> SourceCode -> Maybe (Int, a)
firstMatching (LineType, Text) -> Maybe a
f (SourceCode -> Maybe (Int, a))
-> (SourceCode -> SourceCode) -> SourceCode -> Maybe (Int, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(LineType, Text)] -> [(LineType, Text)])
-> SourceCode -> SourceCode
forall a b. Coercible a b => (b -> b) -> a -> a
inner @_ @[CodeLine] [(LineType, Text)] -> [(LineType, Text)]
forall a. [a] -> [a]
reverse (SourceCode -> Maybe (Int, a)) -> SourceCode -> Maybe (Int, a)
forall a b. (a -> b) -> a -> b
$ SourceCode
sc
      lastIdx :: Int
lastIdx  = [(LineType, Text)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (SourceCode -> [(LineType, Text)]
coerce SourceCode
sc :: [CodeLine]) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
  in  ((Int, a) -> (Int, a)) -> Maybe (Int, a) -> Maybe (Int, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Int -> Int) -> (Int, a) -> (Int, a)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Int
lastIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
-)) Maybe (Int, a)
matching


-- | Strips empty lines at the beginning of source code.
--
-- >>> stripStart $ SourceCode [(Code, ""), (Code, "foo"), (Code, "")]
-- SourceCode [(Code,"foo"),(Code,"")]
stripStart :: SourceCode
           -- ^ source code to strip
           -> SourceCode
           -- ^ stripped source code
stripStart :: SourceCode -> SourceCode
stripStart = ([(LineType, Text)] -> [(LineType, Text)])
-> SourceCode -> SourceCode
forall a b. Coercible a b => (b -> b) -> a -> a
inner @_ @[CodeLine] (((LineType, Text) -> Bool)
-> [(LineType, Text)] -> [(LineType, Text)]
forall a. (a -> Bool) -> [a] -> [a]
L.dropWhile (Text -> Bool
T.null (Text -> Bool)
-> ((LineType, Text) -> Text) -> (LineType, Text) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.strip (Text -> Text)
-> ((LineType, Text) -> Text) -> (LineType, Text) -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LineType, Text) -> Text
forall a b. (a, b) -> b
snd))


-- | Strips empty lines at the end of source code.
--
-- >>> stripEnd $ SourceCode [(Code, ""), (Code, "foo"), (Code, "")]
-- SourceCode [(Code,""),(Code,"foo")]
stripEnd :: SourceCode
         -- ^ source code to strip
         -> SourceCode
         -- ^ stripped source code
stripEnd :: SourceCode -> SourceCode
stripEnd = ([(LineType, Text)] -> [(LineType, Text)])
-> SourceCode -> SourceCode
forall a b. Coercible a b => (b -> b) -> a -> a
inner @_ @[CodeLine] (((LineType, Text) -> Bool)
-> [(LineType, Text)] -> [(LineType, Text)]
forall a. (a -> Bool) -> [a] -> [a]
L.dropWhileEnd (Text -> Bool
T.null (Text -> Bool)
-> ((LineType, Text) -> Text) -> (LineType, Text) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.strip (Text -> Text)
-> ((LineType, Text) -> Text) -> (LineType, Text) -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LineType, Text) -> Text
forall a b. (a, b) -> b
snd))


-- | Cuts snippet from the source code using the given start and end position.
--
-- >>> cut 1 3 $ SourceCode [(Code, "1"), (Code, "2"),(Code, "3"),(Code, "4")]
-- SourceCode [(Code,"2"),(Code,"3")]
cut :: Int
    -- ^ index of first line to be included into the snippet
    -> Int
    -- ^ index of the first line after the snippet
    -> SourceCode
    -- ^ source code to cut
    -> SourceCode
    -- ^ cut snippet
cut :: Int -> Int -> SourceCode -> SourceCode
cut Int
s Int
e = ([(LineType, Text)] -> [(LineType, Text)])
-> SourceCode -> SourceCode
forall a b. Coercible a b => (b -> b) -> a -> a
inner @_ @[CodeLine] (Int -> [(LineType, Text)] -> [(LineType, Text)]
forall a. Int -> [a] -> [a]
L.take (Int
e Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
s) ([(LineType, Text)] -> [(LineType, Text)])
-> ([(LineType, Text)] -> [(LineType, Text)])
-> [(LineType, Text)]
-> [(LineType, Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [(LineType, Text)] -> [(LineType, Text)]
forall a. Int -> [a] -> [a]
L.drop Int
s)