{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ViewPatterns #-}
module Headroom.SourceCode
(
LineType(..)
, CodeLine
, SourceCode(..)
, 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 LineType
= Code
|
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 CodeLine = (LineType, Text)
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)
fromText :: a
-> (Text -> State a LineType)
-> Text
-> 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
toText :: SourceCode
-> 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
firstMatching :: (CodeLine -> Maybe a)
-> SourceCode
-> Maybe (Int, a)
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)
lastMatching :: (CodeLine -> Maybe a)
-> SourceCode
-> Maybe (Int, a)
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
stripStart :: SourceCode
-> SourceCode
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))
stripEnd :: SourceCode
-> SourceCode
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))
cut :: Int
-> Int
-> SourceCode
-> SourceCode
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)