{-# LANGUAGE BlockArguments             #-}
{-# LANGUAGE DerivingStrategies         #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase                 #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE RecordWildCards            #-}
{-# LANGUAGE StandaloneDeriving         #-}
{-# LANGUAGE TupleSections              #-}
module Language.Haskell.Stylish.Module
  ( -- * Data types
    Module
  , Comments (..)
  , Lines

    -- * Getters
  , moduleImportGroups
  , queryModule
  , groupByLine

    -- * Imports
  , canMergeImport
  , mergeModuleImport
  , importModuleName

    -- * Pragmas
  , moduleLanguagePragmas
  ) where


--------------------------------------------------------------------------------
import           Data.Char                    (toLower)
import           Data.Function                (on)
import           Data.Generics                (Typeable, everything, mkQ)
import qualified Data.List                    as L
import           Data.List.NonEmpty           (NonEmpty (..))
import           Data.Maybe                   (fromMaybe, mapMaybe)
import           GHC.Hs                       (ImportDecl (..),
                                               ImportDeclQualifiedStyle (..))
import qualified GHC.Hs                       as GHC
import           GHC.Hs.Extension             (GhcPs)
import qualified GHC.Types.PkgQual            as GHC
import           GHC.Types.SrcLoc             (GenLocated (..),
                                               RealSrcSpan (..), unLoc)
import qualified GHC.Types.SrcLoc             as GHC


--------------------------------------------------------------------------------
import           Language.Haskell.Stylish.GHC


--------------------------------------------------------------------------------
type Lines = [String]

deriving instance Eq GHC.RawPkgQual

--------------------------------------------------------------------------------
-- | Concrete module type
type Module = GHC.Located (GHC.HsModule GHC.GhcPs)

importModuleName :: ImportDecl GhcPs -> String
importModuleName :: ImportDecl GhcPs -> [Char]
importModuleName = ModuleName -> [Char]
GHC.moduleNameString (ModuleName -> [Char])
-> (ImportDecl GhcPs -> ModuleName) -> ImportDecl GhcPs -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA ModuleName -> ModuleName
forall l e. GenLocated l e -> e
GHC.unLoc (GenLocated SrcSpanAnnA ModuleName -> ModuleName)
-> (ImportDecl GhcPs -> GenLocated SrcSpanAnnA ModuleName)
-> ImportDecl GhcPs
-> ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ImportDecl GhcPs -> XRec GhcPs ModuleName
ImportDecl GhcPs -> GenLocated SrcSpanAnnA ModuleName
forall pass. ImportDecl pass -> XRec pass ModuleName
GHC.ideclName

-- | Returns true if the two import declarations can be merged
canMergeImport :: ImportDecl GhcPs -> ImportDecl GhcPs -> Bool
canMergeImport :: ImportDecl GhcPs -> ImportDecl GhcPs -> Bool
canMergeImport ImportDecl GhcPs
i0 ImportDecl GhcPs
i1 = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ ((ImportDecl GhcPs -> ImportDecl GhcPs -> Bool) -> Bool)
-> [ImportDecl GhcPs -> ImportDecl GhcPs -> Bool] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ImportDecl GhcPs -> ImportDecl GhcPs -> Bool
f -> ImportDecl GhcPs -> ImportDecl GhcPs -> Bool
f ImportDecl GhcPs
i0 ImportDecl GhcPs
i1)
  [ ModuleName -> ModuleName -> Bool
forall a. Eq a => a -> a -> Bool
(==) (ModuleName -> ModuleName -> Bool)
-> (ImportDecl GhcPs -> ModuleName)
-> ImportDecl GhcPs
-> ImportDecl GhcPs
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` GenLocated SrcSpanAnnA ModuleName -> ModuleName
forall l e. GenLocated l e -> e
unLoc (GenLocated SrcSpanAnnA ModuleName -> ModuleName)
-> (ImportDecl GhcPs -> GenLocated SrcSpanAnnA ModuleName)
-> ImportDecl GhcPs
-> ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ImportDecl GhcPs -> XRec GhcPs ModuleName
ImportDecl GhcPs -> GenLocated SrcSpanAnnA ModuleName
forall pass. ImportDecl pass -> XRec pass ModuleName
ideclName
  , RawPkgQual -> RawPkgQual -> Bool
forall a. Eq a => a -> a -> Bool
(==) (RawPkgQual -> RawPkgQual -> Bool)
-> (ImportDecl GhcPs -> RawPkgQual)
-> ImportDecl GhcPs
-> ImportDecl GhcPs
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` ImportDecl GhcPs -> ImportDeclPkgQual GhcPs
ImportDecl GhcPs -> RawPkgQual
forall pass. ImportDecl pass -> ImportDeclPkgQual pass
ideclPkgQual
  , IsBootInterface -> IsBootInterface -> Bool
forall a. Eq a => a -> a -> Bool
(==) (IsBootInterface -> IsBootInterface -> Bool)
-> (ImportDecl GhcPs -> IsBootInterface)
-> ImportDecl GhcPs
-> ImportDecl GhcPs
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` ImportDecl GhcPs -> IsBootInterface
forall pass. ImportDecl pass -> IsBootInterface
ideclSource
  , ImportDeclQualifiedStyle -> ImportDeclQualifiedStyle -> Bool
hasMergableQualified (ImportDeclQualifiedStyle -> ImportDeclQualifiedStyle -> Bool)
-> (ImportDecl GhcPs -> ImportDeclQualifiedStyle)
-> ImportDecl GhcPs
-> ImportDecl GhcPs
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` ImportDecl GhcPs -> ImportDeclQualifiedStyle
forall pass. ImportDecl pass -> ImportDeclQualifiedStyle
ideclQualified
  , Maybe ModuleName -> Maybe ModuleName -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Maybe ModuleName -> Maybe ModuleName -> Bool)
-> (ImportDecl GhcPs -> Maybe ModuleName)
-> ImportDecl GhcPs
-> ImportDecl GhcPs
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (GenLocated SrcSpanAnnA ModuleName -> ModuleName)
-> Maybe (GenLocated SrcSpanAnnA ModuleName) -> Maybe ModuleName
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated SrcSpanAnnA ModuleName -> ModuleName
forall l e. GenLocated l e -> e
unLoc (Maybe (GenLocated SrcSpanAnnA ModuleName) -> Maybe ModuleName)
-> (ImportDecl GhcPs -> Maybe (GenLocated SrcSpanAnnA ModuleName))
-> ImportDecl GhcPs
-> Maybe ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ImportDecl GhcPs -> Maybe (XRec GhcPs ModuleName)
ImportDecl GhcPs -> Maybe (GenLocated SrcSpanAnnA ModuleName)
forall pass. ImportDecl pass -> Maybe (XRec pass ModuleName)
ideclAs
  , Maybe ImportListInterpretation
-> Maybe ImportListInterpretation -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Maybe ImportListInterpretation
 -> Maybe ImportListInterpretation -> Bool)
-> (ImportDecl GhcPs -> Maybe ImportListInterpretation)
-> ImportDecl GhcPs
-> ImportDecl GhcPs
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` ((ImportListInterpretation,
  GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)])
 -> ImportListInterpretation)
-> Maybe
     (ImportListInterpretation,
      GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)])
-> Maybe ImportListInterpretation
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ImportListInterpretation,
 GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)])
-> ImportListInterpretation
forall a b. (a, b) -> a
fst (Maybe
   (ImportListInterpretation,
    GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)])
 -> Maybe ImportListInterpretation)
-> (ImportDecl GhcPs
    -> Maybe
         (ImportListInterpretation,
          GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]))
-> ImportDecl GhcPs
-> Maybe ImportListInterpretation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ImportDecl GhcPs
-> Maybe (ImportListInterpretation, XRec GhcPs [LIE GhcPs])
ImportDecl GhcPs
-> Maybe
     (ImportListInterpretation,
      GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)])
forall pass.
ImportDecl pass
-> Maybe (ImportListInterpretation, XRec pass [LIE pass])
ideclImportList -- same 'hiding' flags
  ]
  where
    hasMergableQualified :: ImportDeclQualifiedStyle -> ImportDeclQualifiedStyle -> Bool
hasMergableQualified ImportDeclQualifiedStyle
QualifiedPre ImportDeclQualifiedStyle
QualifiedPost = Bool
True
    hasMergableQualified ImportDeclQualifiedStyle
QualifiedPost ImportDeclQualifiedStyle
QualifiedPre = Bool
True
    hasMergableQualified ImportDeclQualifiedStyle
q0 ImportDeclQualifiedStyle
q1                      = ImportDeclQualifiedStyle
q0 ImportDeclQualifiedStyle -> ImportDeclQualifiedStyle -> Bool
forall a. Eq a => a -> a -> Bool
== ImportDeclQualifiedStyle
q1

-- | Comments associated with module
newtype Comments = Comments [GHC.RealLocated GHC.EpaComment]

-- | Get groups of imports from module
moduleImportGroups :: Module -> [NonEmpty (GHC.LImportDecl GHC.GhcPs)]
moduleImportGroups :: Module -> [NonEmpty (LImportDecl GhcPs)]
moduleImportGroups =
    (GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> RealSrcSpan)
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> [NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))]
forall a. (a -> RealSrcSpan) -> [a] -> [NonEmpty a]
groupByLine (RealSrcSpan -> Maybe RealSrcSpan -> RealSrcSpan
forall a. a -> Maybe a -> a
fromMaybe RealSrcSpan
forall {a}. a
err (Maybe RealSrcSpan -> RealSrcSpan)
-> (GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> Maybe RealSrcSpan)
-> GenLocated SrcSpanAnnA (ImportDecl GhcPs)
-> RealSrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpan -> Maybe RealSrcSpan
GHC.srcSpanToRealSrcSpan (SrcSpan -> Maybe RealSrcSpan)
-> (GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> SrcSpan)
-> GenLocated SrcSpanAnnA (ImportDecl GhcPs)
-> Maybe RealSrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
GHC.getLocA) ([GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
 -> [NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))])
-> (Module -> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)])
-> Module
-> [NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    HsModule GhcPs -> [LImportDecl GhcPs]
HsModule GhcPs -> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
forall p. HsModule p -> [LImportDecl p]
GHC.hsmodImports (HsModule GhcPs -> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)])
-> (Module -> HsModule GhcPs)
-> Module
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Module -> HsModule GhcPs
forall l e. GenLocated l e -> e
GHC.unLoc
  where
    err :: a
err = [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"moduleImportGroups: import without soure span"

-- The same logic as 'Language.Haskell.Stylish.Module.moduleImportGroups'.
groupByLine :: (a -> RealSrcSpan) -> [a] -> [NonEmpty a]
groupByLine :: forall a. (a -> RealSrcSpan) -> [a] -> [NonEmpty a]
groupByLine a -> RealSrcSpan
f = [a] -> Maybe Int -> [a] -> [NonEmpty a]
go [] Maybe Int
forall a. Maybe a
Nothing
  where
    go :: [a] -> Maybe Int -> [a] -> [NonEmpty a]
go [a]
acc Maybe Int
_ [] = [a] -> [NonEmpty a]
forall {a}. [a] -> [NonEmpty a]
ne [a]
acc
    go [a]
acc Maybe Int
mbCurrentLine (a
x:[a]
xs) =
      let
        lStart :: Int
lStart = RealSrcSpan -> Int
GHC.srcSpanStartLine (a -> RealSrcSpan
f a
x)
        lEnd :: Int
lEnd = RealSrcSpan -> Int
GHC.srcSpanEndLine (a -> RealSrcSpan
f a
x) in
      case Maybe Int
mbCurrentLine of
        Just Int
lPrevEnd | Int
lPrevEnd Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
lStart
          -> [a] -> [NonEmpty a]
forall {a}. [a] -> [NonEmpty a]
ne [a]
acc [NonEmpty a] -> [NonEmpty a] -> [NonEmpty a]
forall a. [a] -> [a] -> [a]
++ [a] -> Maybe Int -> [a] -> [NonEmpty a]
go [a
x] (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
lEnd) [a]
xs
        Maybe Int
_ -> [a] -> Maybe Int -> [a] -> [NonEmpty a]
go ([a]
acc [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a
x]) (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
lEnd) [a]
xs

    ne :: [a] -> [NonEmpty a]
ne []       = []
    ne (a
x : [a]
xs) = [a
x a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| [a]
xs]

-- | Merge two import declarations, keeping positions from the first
--
--   As alluded, this highlights an issue with merging imports. The GHC
--   annotation comments aren't attached to any particular AST node. This
--   means that right now, we're manually reconstructing the attachment. By
--   merging two import declarations, we lose that mapping.
--
--   It's not really a big deal if we consider that people don't usually
--   comment imports themselves. It _is_ however, systemic and it'd be better
--   if we processed comments beforehand and attached them to all AST nodes in
--   our own representation.
mergeModuleImport
    :: GHC.LImportDecl GHC.GhcPs -> GHC.LImportDecl GHC.GhcPs
    -> GHC.LImportDecl GHC.GhcPs
mergeModuleImport :: LImportDecl GhcPs -> LImportDecl GhcPs -> LImportDecl GhcPs
mergeModuleImport (L SrcSpanAnnA
p0 ImportDecl GhcPs
i0) (L SrcSpanAnnA
_p1 ImportDecl GhcPs
i1) =
  SrcSpanAnnA
-> ImportDecl GhcPs -> GenLocated SrcSpanAnnA (ImportDecl GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
p0 (ImportDecl GhcPs -> GenLocated SrcSpanAnnA (ImportDecl GhcPs))
-> ImportDecl GhcPs -> GenLocated SrcSpanAnnA (ImportDecl GhcPs)
forall a b. (a -> b) -> a -> b
$ ImportDecl GhcPs
i0 { ideclImportList = newImportNames }
  where
    newImportNames :: Maybe
  (ImportListInterpretation, GenLocated SrcSpanAnnL [LIE GhcPs])
newImportNames =
      case (ImportDecl GhcPs
-> Maybe (ImportListInterpretation, XRec GhcPs [LIE GhcPs])
forall pass.
ImportDecl pass
-> Maybe (ImportListInterpretation, XRec pass [LIE pass])
ideclImportList ImportDecl GhcPs
i0, ImportDecl GhcPs
-> Maybe (ImportListInterpretation, XRec GhcPs [LIE GhcPs])
forall pass.
ImportDecl pass
-> Maybe (ImportListInterpretation, XRec pass [LIE pass])
ideclImportList ImportDecl GhcPs
i1) of
        (Just (ImportListInterpretation
b, L SrcSpanAnnL
p [LIE GhcPs]
imps0), Just (ImportListInterpretation
_, L SrcSpanAnnL
_ [LIE GhcPs]
imps1)) -> (ImportListInterpretation, GenLocated SrcSpanAnnL [LIE GhcPs])
-> Maybe
     (ImportListInterpretation, GenLocated SrcSpanAnnL [LIE GhcPs])
forall a. a -> Maybe a
Just (ImportListInterpretation
b, SrcSpanAnnL -> [LIE GhcPs] -> GenLocated SrcSpanAnnL [LIE GhcPs]
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnL
p ([LIE GhcPs]
imps0 [LIE GhcPs] -> [LIE GhcPs] -> [LIE GhcPs]
forall {a}. Outputable a => [a] -> [a] -> [a]
`merge` [LIE GhcPs]
imps1))
        (Maybe
  (ImportListInterpretation, GenLocated SrcSpanAnnL [LIE GhcPs])
Nothing, Maybe
  (ImportListInterpretation, GenLocated SrcSpanAnnL [LIE GhcPs])
Nothing) -> Maybe
  (ImportListInterpretation, GenLocated SrcSpanAnnL [LIE GhcPs])
forall a. Maybe a
Nothing
        (Just (ImportListInterpretation, GenLocated SrcSpanAnnL [LIE GhcPs])
x, Maybe
  (ImportListInterpretation, GenLocated SrcSpanAnnL [LIE GhcPs])
Nothing) -> (ImportListInterpretation, GenLocated SrcSpanAnnL [LIE GhcPs])
-> Maybe
     (ImportListInterpretation, GenLocated SrcSpanAnnL [LIE GhcPs])
forall a. a -> Maybe a
Just (ImportListInterpretation, GenLocated SrcSpanAnnL [LIE GhcPs])
x
        (Maybe
  (ImportListInterpretation, GenLocated SrcSpanAnnL [LIE GhcPs])
Nothing, Just (ImportListInterpretation, GenLocated SrcSpanAnnL [LIE GhcPs])
x) -> (ImportListInterpretation, GenLocated SrcSpanAnnL [LIE GhcPs])
-> Maybe
     (ImportListInterpretation, GenLocated SrcSpanAnnL [LIE GhcPs])
forall a. a -> Maybe a
Just (ImportListInterpretation, GenLocated SrcSpanAnnL [LIE GhcPs])
x
    merge :: [a] -> [a] -> [a]
merge [a]
xs [a]
ys
      = (a -> a -> Bool) -> [a] -> [a]
forall a. (a -> a -> Bool) -> [a] -> [a]
L.nubBy ([Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
(==) ([Char] -> [Char] -> Bool) -> (a -> [Char]) -> a -> a -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` a -> [Char]
forall a. Outputable a => a -> [Char]
showOutputable) ([a]
xs [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
ys)

-- | Query the module AST using @f@
queryModule :: Typeable a => (a -> [b]) -> Module -> [b]
queryModule :: forall a b. Typeable a => (a -> [b]) -> Module -> [b]
queryModule a -> [b]
f = ([b] -> [b] -> [b]) -> GenericQ [b] -> GenericQ [b]
forall r. (r -> r -> r) -> GenericQ r -> GenericQ r
everything [b] -> [b] -> [b]
forall a. [a] -> [a] -> [a]
(++) ([b] -> (a -> [b]) -> a -> [b]
forall a b r. (Typeable a, Typeable b) => r -> (b -> r) -> a -> r
mkQ [] a -> [b]
f)

moduleLanguagePragmas :: Module -> [(RealSrcSpan, NonEmpty String)]
moduleLanguagePragmas :: Module -> [(RealSrcSpan, NonEmpty [Char])]
moduleLanguagePragmas =
    (LEpaComment -> Maybe (RealSrcSpan, NonEmpty [Char]))
-> [LEpaComment] -> [(RealSrcSpan, NonEmpty [Char])]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe LEpaComment -> Maybe (RealSrcSpan, NonEmpty [Char])
prag ([LEpaComment] -> [(RealSrcSpan, NonEmpty [Char])])
-> (Module -> [LEpaComment])
-> Module
-> [(RealSrcSpan, NonEmpty [Char])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EpAnn AnnsModule -> [LEpaComment]
forall a. EpAnn a -> [LEpaComment]
epAnnComments (EpAnn AnnsModule -> [LEpaComment])
-> (Module -> EpAnn AnnsModule) -> Module -> [LEpaComment]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XModulePs -> EpAnn AnnsModule
GHC.hsmodAnn (XModulePs -> EpAnn AnnsModule)
-> (Module -> XModulePs) -> Module -> EpAnn AnnsModule
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsModule GhcPs -> XCModule GhcPs
HsModule GhcPs -> XModulePs
forall p. HsModule p -> XCModule p
GHC.hsmodExt (HsModule GhcPs -> XModulePs)
-> (Module -> HsModule GhcPs) -> Module -> XModulePs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Module -> HsModule GhcPs
forall l e. GenLocated l e -> e
GHC.unLoc
  where
    prag :: GHC.LEpaComment -> Maybe (GHC.RealSrcSpan, NonEmpty String)
    prag :: LEpaComment -> Maybe (RealSrcSpan, NonEmpty [Char])
prag LEpaComment
comment = case EpaComment -> EpaCommentTok
GHC.ac_tok (LEpaComment -> EpaComment
forall l e. GenLocated l e -> e
GHC.unLoc LEpaComment
comment) of
        GHC.EpaBlockComment [Char]
str
            | [Char]
lang : [Char]
p1 : [[Char]]
ps <- [Char] -> [[Char]]
tokenize [Char]
str, (Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower [Char]
lang [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"language" ->
                (RealSrcSpan, NonEmpty [Char])
-> Maybe (RealSrcSpan, NonEmpty [Char])
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Anchor -> RealSrcSpan
GHC.anchor (LEpaComment -> Anchor
forall l e. GenLocated l e -> l
GHC.getLoc LEpaComment
comment), [Char]
p1 [Char] -> [[Char]] -> NonEmpty [Char]
forall a. a -> [a] -> NonEmpty a
:| [[Char]]
ps)
        EpaCommentTok
_ -> Maybe (RealSrcSpan, NonEmpty [Char])
forall a. Maybe a
Nothing

    tokenize :: [Char] -> [[Char]]
tokenize = [Char] -> [[Char]]
words ([Char] -> [[Char]]) -> ([Char] -> [Char]) -> [Char] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        (Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map (\Char
c -> if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
',' then Char
' ' else Char
c) ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'#') ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
drop Int
1 ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'#')