Merge pull request #889 from GaloisInc/docstring-text

Docstring text

src/Cryptol/ModuleSystem/Interface.hs

@@ -32,6 +32,7 @@ import           Cryptol.Parser.Position(Located)
 
 import qualified Data.Map as Map
 import           Data.Semigroup
+import           Data.Text (Text)
 
 import GHC.Generics (Generic)
 import Control.DeepSeq
@@ -100,7 +101,7 @@ data IfaceDecl = IfaceDecl
   , ifDeclPragmas :: [Pragma]       -- ^ Pragmas
   , ifDeclInfix   :: Bool           -- ^ Is this an infix thing
   , ifDeclFixity  :: Maybe Fixity   -- ^ Fixity information
-  , ifDeclDoc     :: Maybe String   -- ^ Documentation
+  , ifDeclDoc     :: Maybe Text     -- ^ Documentation
   } deriving (Show, Generic, NFData)
 
 mkIfaceDecl :: Decl -> IfaceDecl

src/Cryptol/Parser.y

@@ -271,10 +271,10 @@ par_decl                         :: { TopDecl PName }
                                             (mkProp $4) }
 
 
-doc                     :: { Located String }
+doc                     :: { Located Text }
   : DOC                    { mkDoc (fmap tokenText $1) }
 
-mbDoc                   :: { Maybe (Located String) }
+mbDoc                   :: { Maybe (Located Text) }
   : doc                    { Just $1 }
   | {- empty -}            { Nothing }
 

src/Cryptol/Parser/AST.hs

@@ -90,6 +90,7 @@ import           Data.List(intersperse)
 import           Data.Bits(shiftR)
 import           Data.Maybe (catMaybes)
 import           Data.Ratio(numerator,denominator)
+import           Data.Text (Text)
 import           Numeric(showIntAtBase,showFloat,showHFloat)
 
 import GHC.Generics (Generic)
@@ -160,7 +161,7 @@ data Decl name = DSignature [Located name] (Schema name)
 data ParameterType name = ParameterType
   { ptName    :: Located name     -- ^ name of type parameter
   , ptKind    :: Kind             -- ^ kind of parameter
-  , ptDoc     :: Maybe String     -- ^ optional documentation
+  , ptDoc     :: Maybe Text       -- ^ optional documentation
   , ptFixity  :: Maybe Fixity     -- ^ info for infix use
   , ptNumber  :: !Int             -- ^ number of the parameter
   } deriving (Eq,Show,Generic,NFData)
@@ -169,7 +170,7 @@ data ParameterType name = ParameterType
 data ParameterFun name = ParameterFun
   { pfName   :: Located name      -- ^ name of value parameter
   , pfSchema :: Schema name       -- ^ schema for parameter
-  , pfDoc    :: Maybe String      -- ^ optional documentation
+  , pfDoc    :: Maybe Text        -- ^ optional documentation
   , pfFixity :: Maybe Fixity      -- ^ info for infix use
   } deriving (Eq,Show,Generic,NFData)
 
@@ -230,7 +231,7 @@ data Bind name = Bind
   , bFixity    :: Maybe Fixity            -- ^ Optional fixity info
   , bPragmas   :: [Pragma]                -- ^ Optional pragmas
   , bMono      :: Bool                    -- ^ Is this a monomorphic binding
-  , bDoc       :: Maybe String            -- ^ Optional doc string
+  , bDoc       :: Maybe Text              -- ^ Optional doc string
   } deriving (Eq, Generic, NFData, Functor, Show)
 
 type LBindDef = Located (BindDef PName)
@@ -270,7 +271,7 @@ data ExportType = Public
 
 -- | A top-level module declaration.
 data TopLevel a = TopLevel { tlExport :: ExportType
-                           , tlDoc    :: Maybe (Located String)
+                           , tlDoc    :: Maybe (Located Text)
                            , tlValue  :: a
                            }
   deriving (Show, Generic, NFData, Functor, Foldable, Traversable)

src/Cryptol/Parser/NoPat.hs

@@ -29,6 +29,7 @@ import Cryptol.Utils.RecordMap
 import           MonadLib hiding (mapM)
 import           Data.Maybe(maybeToList)
 import qualified Data.Map as Map
+import           Data.Text (Text)
 
 import GHC.Generics (Generic)
 import Control.DeepSeq
@@ -323,7 +324,7 @@ data AnnotMap = AnnotMap
   , annSigs     :: Map.Map PName [Located (Schema PName)]
   , annValueFs  :: Map.Map PName [Located  Fixity       ]
   , annTypeFs   :: Map.Map PName [Located  Fixity       ]
-  , annDocs     :: Map.Map PName [Located  String       ]
+  , annDocs     :: Map.Map PName [Located  Text         ]
   }
 
 type Annotates a = a -> StateT AnnotMap NoPatM a
@@ -477,7 +478,7 @@ checkFixs f fs@(x:_) = do recordError $ MultipleFixities f $ map srcRange fs
                           return (Just (thing x))
 
 
-checkDocs :: PName -> [Located String] -> NoPatM (Maybe String)
+checkDocs :: PName -> [Located Text] -> NoPatM (Maybe Text)
 checkDocs _ []       = return Nothing
 checkDocs _ [d]      = return (Just (thing d))
 checkDocs f ds@(d:_) = do recordError $ MultipleDocs f (map srcRange ds)
@@ -502,7 +503,7 @@ toFixity (DFixity f ns) = [ (thing n, [Located (srcRange n) f]) | n <- ns ]
 toFixity _              = []
 
 -- | Does this top-level declaration provide a documentation string?
-toDocs :: TopLevel (Decl PName) -> [(PName, [Located String])]
+toDocs :: TopLevel (Decl PName) -> [(PName, [Located Text])]
 toDocs TopLevel { .. }
   | Just txt <- tlDoc = go txt tlValue
   | otherwise = []

src/Cryptol/Parser/ParserUtils.hs

@@ -360,18 +360,18 @@ anonTyApp ~(Just r) ts = TTyApp (map toField ts)
   where noName    = Located { srcRange = r, thing = mkIdent (T.pack "") }
         toField t = Named { name = noName, value = t }
 
-exportDecl :: Maybe (Located String) -> ExportType -> Decl PName -> TopDecl PName
+exportDecl :: Maybe (Located Text) -> ExportType -> Decl PName -> TopDecl PName
 exportDecl mbDoc e d = Decl TopLevel { tlExport = e
                                      , tlDoc    = mbDoc
                                      , tlValue  = d }
 
-exportNewtype :: ExportType -> Maybe (Located String) -> Newtype PName ->
+exportNewtype :: ExportType -> Maybe (Located Text) -> Newtype PName ->
                                                             TopDecl PName
 exportNewtype e d n = TDNewtype TopLevel { tlExport = e
                                          , tlDoc    = d
                                          , tlValue  = n }
 
-mkParFun :: Maybe (Located String) ->
+mkParFun :: Maybe (Located Text) ->
             Located PName ->
             Schema PName ->
             TopDecl PName
@@ -381,7 +381,7 @@ mkParFun mbDoc n s = DParameterFun ParameterFun { pfName = n
                                                 , pfFixity = Nothing
                                                 }
 
-mkParType :: Maybe (Located String) ->
+mkParType :: Maybe (Located Text) ->
              Located PName ->
              Located Kind ->
              ParseM (TopDecl PName)
@@ -515,7 +515,7 @@ mkIf ifThens theElse = foldr addIfThen theElse ifThens
 -- instead of just place it on the binding directly.  A better solution might be
 -- to just have a different constructor for primitives.
 mkPrimDecl ::
-  Maybe (Located String) -> LPName -> Schema PName -> [TopDecl PName]
+  Maybe (Located Text) -> LPName -> Schema PName -> [TopDecl PName]
 mkPrimDecl mbDoc ln sig =
   [ exportDecl mbDoc Public
     $ DBind Bind { bName      = ln
@@ -533,7 +533,7 @@ mkPrimDecl mbDoc ln sig =
   ]
 
 mkPrimTypeDecl ::
-  Maybe (Located String) ->
+  Maybe (Located Text) ->
   Schema PName ->
   Located Kind ->
   ParseM [TopDecl PName]
@@ -601,12 +601,11 @@ mkPrimTypeDecl mbDoc (Forall as qs st ~(Just schema_rng)) finK =
 
 -- | Fix-up the documentation strings by removing the comment delimiters on each
 -- end, and stripping out common prefixes on all the remaining lines.
-mkDoc :: Located Text -> Located String
+mkDoc :: Located Text -> Located Text
 mkDoc ltxt = ltxt { thing = docStr }
   where
 
-  docStr = unlines
-         $ map T.unpack
+  docStr = T.unlines
          $ dropPrefix
          $ trimFront
          $ T.lines

src/Cryptol/REPL/Command.hs

@@ -1386,11 +1386,7 @@ helpCmd cmd
                                     "requires:" $$ nest 2 (vcat rs)
 
                    doShowFix (T.atFixitiy a)
-
-                   case T.atDoc a of
-                     Nothing -> pure ()
-                     Just d -> do rPutStrLn ""
-                                  rPutStrLn d
+                   doShowDocString (T.atDoc a)
 
     fromTyParam =
       do p <- Map.lookup name (M.ifParamTypes params)
@@ -1408,9 +1404,7 @@ helpCmd cmd
   doShowTyHelp nameEnv decl doc =
     do rPutStrLn ""
        rPrint (runDoc nameEnv (nest 4 decl))
-       case doc of
-         Nothing -> return ()
-         Just d  -> rPutStrLn "" >> rPutStrLn d
+       doShowDocString doc
 
   doShowFix fx =
     case fx of
@@ -1447,9 +1441,7 @@ helpCmd cmd
               doShowFix $ ifDeclFixity `mplus`
                           (guard ifDeclInfix >> return P.defaultFixity)
 
-              case ifDeclDoc of
-                Just str -> rPutStrLn ('\n' : str)
-                Nothing  -> return ()
+              doShowDocString ifDeclDoc
 
     fromNewtype =
       do _ <- Map.lookup name (M.ifNewtypes env)
@@ -1466,10 +1458,12 @@ helpCmd cmd
                                         <+> pp (T.mvpType p)
 
               doShowFix (T.mvpFixity p)
+              doShowDocString (T.mvpDoc p)
 
-              case T.mvpDoc p of
-                Just str -> rPutStrLn ('\n' : str)
-                Nothing  -> return ()
+  doShowDocString doc =
+    case doc of
+      Nothing -> pure ()
+      Just d  -> rPutStrLn ('\n' : T.unpack d)
 
   showCmdHelp c [arg] | ":set" `elem` cNames c = showOptionHelp arg
   showCmdHelp c _args =

src/Cryptol/TypeCheck/AST.hs

@@ -47,6 +47,7 @@ import Control.DeepSeq
 import           Data.Map    (Map)
 import qualified Data.Map    as Map
 import qualified Data.IntMap as IntMap
+import           Data.Text (Text)
 
 
 -- | A Cryptol module.
@@ -80,7 +81,7 @@ data ModTParam = ModTParam
                       -- This is used when we move parameters from the module
                       -- level to individual declarations
                       -- (type synonyms in particular)
-  , mtpDoc    :: Maybe String
+  , mtpDoc    :: Maybe Text
   } deriving (Show,Generic,NFData)
 
 mtpParam :: ModTParam -> TParam
@@ -97,7 +98,7 @@ mtpParam mtp = TParam { tpUnique = nameUnique (mtpName mtp)
 data ModVParam = ModVParam
   { mvpName   :: Name
   , mvpType   :: Schema
-  , mvpDoc    :: Maybe String
+  , mvpDoc    :: Maybe Text
   , mvpFixity :: Maybe Fixity
   } deriving (Show,Generic,NFData)
 
@@ -168,7 +169,7 @@ data Decl       = Decl { dName        :: !Name
                        , dPragmas     :: [Pragma]
                        , dInfix       :: !Bool
                        , dFixity      :: Maybe Fixity
-                       , dDoc         :: Maybe String
+                       , dDoc         :: Maybe Text
                        } deriving (Generic, NFData, Show)
 
 data DeclDef    = DPrim

src/Cryptol/TypeCheck/Depends.hs

@@ -27,16 +27,17 @@ import           Data.Graph (SCC(..))
 import           Data.Map (Map)
 import qualified Data.Map as Map
 import qualified Data.Set as Set
+import           Data.Text (Text)
 
 data TyDecl =
-    TS (P.TySyn Name) (Maybe String)          -- ^ Type synonym
-  | NT (P.Newtype Name) (Maybe String)        -- ^ Newtype
-  | AT (P.ParameterType Name) (Maybe String)  -- ^ Parameter type
-  | PS (P.PropSyn Name) (Maybe String)        -- ^ Property synonym
-  | PT (P.PrimType Name) (Maybe String)       -- ^ A primitive/abstract typee
+    TS (P.TySyn Name) (Maybe Text)          -- ^ Type synonym
+  | NT (P.Newtype Name) (Maybe Text)        -- ^ Newtype
+  | AT (P.ParameterType Name) (Maybe Text)  -- ^ Parameter type
+  | PS (P.PropSyn Name) (Maybe Text)        -- ^ Property synonym
+  | PT (P.PrimType Name) (Maybe Text)       -- ^ A primitive/abstract typee
     deriving Show
 
-setDocString :: Maybe String -> TyDecl -> TyDecl
+setDocString :: Maybe Text -> TyDecl -> TyDecl
 setDocString x d =
   case d of
     TS a _ -> TS a x

src/Cryptol/TypeCheck/Kind.hs

@@ -36,6 +36,7 @@ import qualified Data.Map as Map
 import           Data.List(sortBy,groupBy)
 import           Data.Maybe(fromMaybe)
 import           Data.Function(on)
+import           Data.Text (Text)
 import           Control.Monad(unless,forM,when)
 
 
@@ -66,7 +67,7 @@ checkSchema withWild (P.Forall xs ps t mb) =
 
 -- | Check a module parameter declarations.  Nothing much to check,
 -- we just translate from one syntax to another.
-checkParameterType :: P.ParameterType Name -> Maybe String -> InferM ModTParam
+checkParameterType :: P.ParameterType Name -> Maybe Text -> InferM ModTParam
 checkParameterType a mbDoc =
   do let k = cvtK (P.ptKind a)
          n = thing (P.ptName a)
@@ -75,7 +76,7 @@ checkParameterType a mbDoc =
 
 
 -- | Check a type-synonym declaration.
-checkTySyn :: P.TySyn Name -> Maybe String -> InferM TySyn
+checkTySyn :: P.TySyn Name -> Maybe Text -> InferM TySyn
 checkTySyn (P.TySyn x _ as t) mbD =
   do ((as1,t1),gs) <- collectGoals
                     $ inRange (srcRange x)
@@ -91,7 +92,7 @@ checkTySyn (P.TySyn x _ as t) mbD =
                   }
 
 -- | Check a constraint-synonym declaration.
-checkPropSyn :: P.PropSyn Name -> Maybe String -> InferM TySyn
+checkPropSyn :: P.PropSyn Name -> Maybe Text -> InferM TySyn
 checkPropSyn (P.PropSyn x _ as ps) mbD =
   do ((as1,t1),gs) <- collectGoals
                     $ inRange (srcRange x)
@@ -108,7 +109,7 @@ checkPropSyn (P.PropSyn x _ as ps) mbD =
 
 -- | Check a newtype declaration.
 -- XXX: Do something with constraints.
-checkNewtype :: P.Newtype Name -> Maybe String -> InferM Newtype
+checkNewtype :: P.Newtype Name -> Maybe Text -> InferM Newtype
 checkNewtype (P.Newtype x as fs) mbD =
   do ((as1,fs1),gs) <- collectGoals $
        inRange (srcRange x) $
@@ -128,7 +129,7 @@ checkNewtype (P.Newtype x as fs) mbD =
                     , ntDoc = mbD
                     }
 
-checkPrimType :: P.PrimType Name -> Maybe String -> InferM AbstractType
+checkPrimType :: P.PrimType Name -> Maybe Text -> InferM AbstractType
 checkPrimType p mbD =
   do let (as,cs) = P.primTCts p
      (as',cs') <- withTParams NoWildCards (TPOther . Just) as $

src/Cryptol/TypeCheck/Type.hs

@@ -15,6 +15,7 @@ import qualified Data.IntMap as IntMap
 import           Data.Maybe (fromMaybe)
 import           Data.Set (Set)
 import qualified Data.Set as Set
+import           Data.Text (Text)
 
 import Cryptol.Parser.Selector
 import Cryptol.Parser.Position(Range,emptyRange)
@@ -169,7 +170,7 @@ data TySyn  = TySyn { tsName        :: Name       -- ^ Name
                     , tsParams      :: [TParam]   -- ^ Parameters
                     , tsConstraints :: [Prop]     -- ^ Ensure body is OK
                     , tsDef         :: Type       -- ^ Definition
-                    , tsDoc         :: !(Maybe String) -- ^ Documentation
+                    , tsDoc         :: !(Maybe Text) -- ^ Documentation
                     }
               deriving (Show, Generic, NFData)
 
@@ -182,7 +183,7 @@ data Newtype  = Newtype { ntName   :: Name
                         , ntParams :: [TParam]
                         , ntConstraints :: [Prop]
                         , ntFields :: [(Ident,Type)]
-                        , ntDoc :: Maybe String
+                        , ntDoc :: Maybe Text
                         } deriving (Show, Generic, NFData)
 
 
@@ -192,7 +193,7 @@ data AbstractType = AbstractType
   , atKind    :: Kind
   , atCtrs    :: ([TParam], [Prop])
   , atFixitiy :: Maybe Fixity
-  , atDoc     :: Maybe String
+  , atDoc     :: Maybe Text
   } deriving (Show, Generic, NFData)