{-# language DeriveFunctor, DeriveFoldable, DeriveTraversable, DeriveGeneric #-}
{-# language DataKinds #-}
{-# language InstanceSigs, ScopedTypeVariables, TypeApplications #-}
{-# language LambdaCase #-}
module Language.Python.Syntax.Import
( ImportAs(..)
, ImportTargets(..)
, importAsAnn
, importAsName
, importAsQual
)
where
import Control.Lens.Getter ((^.), getting, to)
import Control.Lens.Lens (Lens, Lens', lens)
import Control.Lens.Prism (_Just)
import Control.Lens.Setter ((.~))
import Control.Lens.Tuple (_2)
import Data.Function ((&))
import Data.List.NonEmpty (NonEmpty)
import Data.Generics.Product.Typed (typed)
import GHC.Generics (Generic)
import Unsafe.Coerce (unsafeCoerce)
import Language.Python.Optics.Validated
import Language.Python.Syntax.Ann
import Language.Python.Syntax.CommaSep
import Language.Python.Syntax.Ident
import Language.Python.Syntax.Whitespace
data ImportAs e v a
= ImportAs
{ _importAsAnn :: Ann a
, _importAsName :: e v a
, _importAsQual :: Maybe (NonEmpty Whitespace, Ident v a)
}
deriving (Eq, Show, Functor, Foldable, Traversable, Generic)
instance HasAnn (ImportAs e v) where
annot :: forall a. Lens' (ImportAs e v a) (Ann a)
annot = typed @(Ann a)
instance Validated e => Validated (ImportAs e) where
unvalidated = to unsafeCoerce
importAsAnn :: Lens' (ImportAs e v a) a
importAsAnn = annot_
importAsName :: Validated e => Lens (ImportAs e v a) (ImportAs e' '[] a) (e v a) (e' '[] a)
importAsName = lens _importAsName (\s a -> (s ^. unvalidated) { _importAsName = a })
importAsQual
:: Validated e
=> Lens
(ImportAs e v a)
(ImportAs e '[] a)
(Maybe (NonEmpty Whitespace, Ident v a))
(Maybe (NonEmpty Whitespace, Ident '[] a))
importAsQual = lens _importAsQual (\s a -> (s ^. unvalidated) { _importAsQual = a })
instance HasTrailingWhitespace (e v a) => HasTrailingWhitespace (ImportAs e v a) where
trailingWhitespace =
lens
(\(ImportAs _ a b) ->
maybe (a ^. getting trailingWhitespace) (^. _2.trailingWhitespace) b)
(\(ImportAs x a b) ws ->
ImportAs
x
(maybe (a & trailingWhitespace .~ ws) (const a) b)
(b & _Just._2.trailingWhitespace .~ ws))
data ImportTargets v a
= ImportAll (Ann a) [Whitespace]
| ImportSome (Ann a) (CommaSep1 (ImportAs Ident v a))
| ImportSomeParens
(Ann a)
[Whitespace]
(CommaSep1' (ImportAs Ident v a))
[Whitespace]
deriving (Eq, Show, Functor, Foldable, Traversable, Generic)
instance HasAnn (ImportTargets v) where
annot :: forall a. Lens' (ImportTargets v a) (Ann a)
annot = typed @(Ann a)
instance HasTrailingWhitespace (ImportTargets v a) where
trailingWhitespace =
lens
(\case
ImportAll _ ws -> ws
ImportSome _ cs -> cs ^. trailingWhitespace
ImportSomeParens _ _ _ ws -> ws)
(\ts ws ->
case ts of
ImportAll a _ -> ImportAll a ws
ImportSome a cs -> ImportSome a (cs & trailingWhitespace .~ ws)
ImportSomeParens x a b _ -> ImportSomeParens x a b ws)